[med-svn] [eigensoft] 03/09: Imported Upstream version 6.1.2+dgsg
Andreas Tille
tille at debian.org
Mon Jul 18 20:16:46 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository eigensoft.
commit dc81bb2b7fed71e60393acb16b3eeabf1f9c7f82
Author: Andreas Tille <tille at debian.org>
Date: Mon Jul 18 21:49:39 2016 +0200
Imported Upstream version 6.1.2+dgsg
---
EIGENSTRAT/README | 42 +-
EIGENSTRAT/example.pcaselection.chisq | 8 +
EIGENSTRAT/example.pcaselection.par | 5 +
LICENSE.txt | 32 +
POPGEN/README | 16 +-
README | 41 +-
bin/{evec2pca-ped.perl => evec2pca-ped.pl} | 0
bin/{evec2pca.perl => evec2pca.pl} | 0
bin/fixgreen | 25 -
bin/{gc.perl => gc.pl} | 0
bin/ploteig | 168 -
bin/{smarteigenstrat.perl => smarteigenstrat.pl} | 0
bin/{smartpca.perl => smartpca.pl} | 0
include/LICENSE.txt | 32 +
include/admutils.h | 393 +-
include/backup/kjg_fpca.h | 71 -
include/backup/kjg_geno.h | 137 -
include/backup/kjg_gsl.h | 73 -
include/badpairs.h | 28 +-
include/egsubs.h | 19 +-
include/eigqpsubs.h | 360 +-
include/eigsubs.h | 25 +-
include/exclude.h | 10 +-
include/getpars.h | 55 +-
include/globals.h | 2 +-
include/gval.h | 26 +-
include/kjg_fpca.h | 12 +-
include/kjg_geno.h | 137 -
include/kjg_gsl.h | 43 +-
include/lapacke.h | 16305 ---------------------
include/ldsubs.h | 62 +-
include/linsubs.h | 30 +-
include/mcio.h | 355 +-
include/mcmcpars.h | 49 +-
include/not-thread-h | 49 -
include/old.h | 43 -
include/packit.h | 12 +-
include/qpsubs.h | 373 +-
include/ranmath.h | 89 +-
include/regsubs.h | 36 +-
include/smartsubs.h | 7 +-
include/sortit.h | 34 +-
include/statsubs.h | 228 +-
include/strsubs.h | 201 +-
include/twtable.h | 12 +
include/vsubs.h | 486 +-
include/workqueue.h | 21 +-
include/xpsubs.h | 65 +-
include/xsearch.h | 42 +-
src/LICENSE.txt | 32 +
src/Makefile | 49 +-
src/admutils.c | 1894 +--
src/baseprog.c | 421 +-
src/convertf.c | 1728 ++-
src/egsubs.c | 260 +-
src/eigensrc/LICENSE.txt | 32 +
src/eigensrc/eigenstrat.c | 637 +-
src/eigensrc/eigenstratQTL.c | 609 +-
src/eigensrc/eigsubs.c | 338 +-
src/eigensrc/eigx.c | 325 +-
src/eigensrc/exclude.c | 146 +-
src/eigensrc/fffpca.c | 5448 +++----
src/eigensrc/newpca.c | 5460 +++----
src/eigensrc/old.c | 3213 ----
src/eigensrc/oldfffpca.c | 3231 ----
src/eigensrc/pcatoy.c | 47 +-
src/eigensrc/q1 | 105 -
src/eigensrc/qdiff | 1000 --
src/eigensrc/qq2.c | 29 -
src/eigensrc/qqq.c | 3139 ----
src/eigensrc/smarteigenstrat.c | 821 +-
src/eigensrc/smartpca.c | 5464 +++----
src/eigensrc/smartrel.c | 2729 ++--
src/eigensrc/smartsubs.c | 159 +-
src/eigensrc/twstats.c | 223 +-
src/eigx.c | 325 +-
src/exclude.c | 146 +-
src/gval.c | 36 +-
src/gval.h | 13 -
src/h2d.c | 146 +-
src/ksrc/LICENSE.txt | 32 +
src/ksrc/kjg_fpca.c | 38 +-
src/ksrc/kjg_gsl.c | 67 +-
src/mcio.c | 8631 ++++++-----
src/mergeit.c | 824 +-
src/mmakefile | 99 -
src/nicksrc/LICENSE.txt | 32 +
src/nicksrc/Makefile | 6 +-
src/nicksrc/gauss.c | 61 +-
src/nicksrc/gds.c | 1075 +-
src/nicksrc/getpars.c | 699 +-
src/nicksrc/linsubs.c | 532 +-
src/nicksrc/sortit.c | 362 +-
src/nicksrc/statsubs.c | 3519 +++--
src/nicksrc/strsubs.c | 2427 +--
src/nicksrc/twtable.c | 94 +
src/nicksrc/vsubs.c | 2728 ++--
src/nicksrc/xsearch.c | 458 +-
src/oldgval.c | 226 -
src/oldmakefile | 74 -
src/oldmcio.c | 4924 -------
src/pca.c | 510 +-
src/pcaselection.c | 344 +
src/qpsubs.c | 6098 ++++----
src/qq | 2 -
src/qqq.c | 5239 ++++---
src/regsubs.c | 766 +-
src/smartpca.gmon.out | Bin 143681 -> 0 bytes
src/smartpca.gmon.profile | 863 --
src/smarttables/twtable | 164 -
src/twsubs.c | 385 +-
111 files changed, 36310 insertions(+), 63433 deletions(-)
diff --git a/EIGENSTRAT/README b/EIGENSTRAT/README
index 62c36e6..b077b95 100644
--- a/EIGENSTRAT/README
+++ b/EIGENSTRAT/README
@@ -1,14 +1,14 @@
See ../README for high-level documentation of the entire EIGENSOFT package.
This file contains documentation of EIGENSTRAT programs:
- smartpca.perl: run PCA on input genotype data (calls smartpca)
- smarteigenstrat.perl: run EIGENSTRAT stratification correction. This program
+ smartpca.pl: run PCA on input genotype data (calls smartpca)
+ smarteigenstrat.pl: run EIGENSTRAT stratification correction. This program
supports all 5 file formats, and supports quantitative phenotypes.
- gc.perl: apply Genomic Control (Devlin and Roeder, 1999) to the
+ gc.pl: apply Genomic Control (Devlin and Roeder, 1999) to the
association statistics computed by EIGENSTRAT.
We note that the programs eigenstrat and eigenstratQTL of EIGENSOFT version 2.0
-have been replaced by smarteigenstrat.perl. However, we have retained the old
+have been replaced by smarteigenstrat.pl. However, we have retained the old
programs for backwards compatibility (see below).
See ./example.perl and ./exampleQTL.perl for toy examples using our programs.
@@ -23,13 +23,13 @@ http://www.hsph.harvard.edu/faculty/alkes-price/files/eigensoftfaq.htm
------------------------------------------------------------------------
-DOCUMENTATION of smartpca.perl program:
+DOCUMENTATION of smartpca.pl program:
This program calls the smartpca program (see ../POPGEN/README).
For this to work, the bin directory containing smartpca MUST be in your path.
See ./example.perl for a toy example.
-../bin/smartpca.perl
+../bin/smartpca.pl
-i example.geno : genotype file in any format (see ../CONVERTF/README)
-a example.snp : snp file in any format (see ../CONVERTF/README)
-b example.ind : indiv file in any format (see ../CONVERTF/README)
@@ -77,15 +77,15 @@ large correlations with phenotype indicate highly mismatched cases vs. controls
------------------------------------------------------------------------
-DOCUMENTATION of smarteigenstrat.perl program: [run smartpca.perl program first]
+DOCUMENTATION of smarteigenstrat.pl program: [run smartpca.pl program first]
This program is a PERL wrapper which calls the C program smarteigenstrat.
Note: the bin directory containing smarteigenstrat MUST be in your path.
See ./example.perl for a toy example.
-We recommend smarteigenstrat.perl for users who prefer command-line flags.
+We recommend smarteigenstrat.pl for users who prefer command-line flags.
However, users who prefer parameter files can run smarteigenstrat instead.
-../bin/smarteigenstrat.perl
+../bin/smarteigenstrat.pl
-i example.geno : genotype file in any format (see ../CONVERTF/README)
-a example.snp : snp file in any format (see ../CONVERTF/README)
-b example.ind : individual file in any format (see ../CONVERTF/README).
@@ -97,7 +97,7 @@ However, users who prefer parameter files can run smarteigenstrat instead.
should be real numbers. The value -100.0 signifies "missing data".
If -q is set to NO, these values should be "Case" or "Control".
The default value for the -q parameter is NO.
--p example.pca : input file of principal components (output of smartpca.perl)
+-p example.pca : input file of principal components (output of smartpca.pl)
-k 1 : (Default is 10) number of principal components along which to
correct for stratification. Note that l must be less than or equal to
the number of principal components reported in the file example.pca.
@@ -116,15 +116,15 @@ However, users who prefer parameter files can run smarteigenstrat instead.
consider to be appropriate.
-l example.log : standard output file
-The running time of smarteigenstrat.perl is very fast compared to
- the running time of smartpca.perl.
+The running time of smarteigenstrat.pl is very fast compared to
+ the running time of smartpca.pl.
------------------------------------------------------------------------
DOCUMENTATION of smarteigenstrat program:
Users who prefer parameter files to command-line flags can run the
-C program smarteigenstrat instead of the PERL wrapper smarteigenstrat.perl.
+C program smarteigenstrat instead of the PERL wrapper smarteigenstrat.pl.
The syntax of smarteigenstrat is "../bin/smarteigenstrat -p parfile"
DESCRIPTION OF EACH PARAMETER in parameter file for smarteigenstrat:
@@ -137,7 +137,7 @@ outputname: name of output file of chisq association statistics
numeigs: number of principal components to correct for
qtmode: YES for quantitative phenotype, NO (default) otherwise
-For details, see documentation of smarteigenstrat.perl above.
+For details, see documentation of smarteigenstrat.pl above.
OPTIONAL PARAMETERS:
@@ -148,9 +148,9 @@ hashcheck: If set to YES and the input genotype file is in PACKEDANCESTRYMAP
------------------------------------------------------------------------
-DOCUMENTATION of gc.perl: [run smartpca.perl & smarteigenstrat.perl first]
+DOCUMENTATION of gc.pl: [run smartpca.pl & smarteigenstrat.pl first]
-../bin/gc.perl infile outfile
+../bin/gc.pl infile outfile
infile is input file of chisq statistics produced by eigenstrat program.
It contains both uncorrected and EIGENSTRAT statistics for each SNP.
outfile is output file. It lists
@@ -160,7 +160,7 @@ Computation of lambda is as described in Devlin and Roeder 1999.
A lambda above 1 indicates inflation in chisq statistics.
By definition, lambda is not allowed to be less than 1.
-Running time of the gc.perl program is very fast.
+Running time of the gc.pl program is very fast.
------------------------------------------------------------------------
@@ -179,7 +179,7 @@ our old program eigenstratQTL (for quantitative phenotypes) from that release,
which have now been replaced by our new program smarteigenstratQTL.perl.
See ./example.oldstyle.perl for an example involving the eigenstrat program.
-Most users will want to use our new program smarteigenstrat.perl, which has
+Most users will want to use our new program smarteigenstrat.pl, which has
added functionality. However, users wishing to understand or modify our
source code may find it advantageous to instead work with the simpler
eigenstrat programs.
@@ -190,10 +190,10 @@ BACKWARDS COMPATIBILITY with 07/23/06 EIGENSTRAT release: pca program
For backwards compatibility with the 07/23/06 EIGENSTRAT release, we have also
included our old program pca used in that release, which has now been replaced
-by our new program smartpca.perl. See ./example.oldstyle.perl for an example
+by our new program smartpca.pl. See ./example.oldstyle.perl for an example
involving the pca program.
-Most users will want to use our new program smartpca.perl, which calls
+Most users will want to use our new program smartpca.pl, which calls
the smartpca program and has added functionality. However, users wishing
to understand or modify our source code may find it advantageous to instead
work with the simpler pca program.
@@ -232,7 +232,7 @@ Thus, if running on much smaller data sets, it is necessary to exclude a
candidate marker from the set of markers used to infer principal components
used to correct for stratification at the candidate marker. In the case of
a data set which uses ancestry-informative markers to infer ancestry, a
-good way to do this is to run smartpca.perl to infer principal components
+good way to do this is to run smartpca.pl to infer principal components
*only* using ancestry-informative markers, excluding the candidate markers
(and excluding any ancestry-informative marker in LD with a candidate marker),
and then run eigenstrat on candidate markers.
diff --git a/EIGENSTRAT/example.pcaselection.chisq b/EIGENSTRAT/example.pcaselection.chisq
new file mode 100644
index 0000000..e7cd7bc
--- /dev/null
+++ b/EIGENSTRAT/example.pcaselection.chisq
@@ -0,0 +1,8 @@
+Chisq PCASELECTION
+rs0000 0.65619 0.935652
+rs1111 1.05351 4.2363
+rs2222 0.698978 1.73221
+rs3333 2.39363 0.295432
+rs4444 1.6562 0.52183
+rs5555 0.770901 0.140059
+rs6666 1.57489 0.942783
diff --git a/EIGENSTRAT/example.pcaselection.par b/EIGENSTRAT/example.pcaselection.par
new file mode 100644
index 0000000..c87299b
--- /dev/null
+++ b/EIGENSTRAT/example.pcaselection.par
@@ -0,0 +1,5 @@
+genotypename: example.geno
+snpname: example.snp
+indivname: example.ind
+pcaname: example.pca.evec
+outputname: example.pcaselection.chisq
diff --git a/LICENSE.txt b/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/POPGEN/README b/POPGEN/README
index c305293..64656a4 100644
--- a/POPGEN/README
+++ b/POPGEN/README
@@ -9,7 +9,7 @@ This file contains documentation of population structure programs:
smartpca: run Principal Components Analysis on input genotype data.
ploteig: construct plot of top 2 principal components
twstats: compute number of statistically significant principal components.
- evec2pca.perl: convert eigenvector file to format needed for EIGENSTRAT
+ evec2pca.pl: convert eigenvector file to format needed for EIGENSTRAT
smartrel: identify related samples, accounting for population structure
------------------------------------------------------------------------
@@ -290,17 +290,17 @@ Example: see ./twexample.perl
-----------------------------------------------------------------------
-DOCUMENTATION OF evec2pca.perl program:
+DOCUMENTATION OF evec2pca.pl program:
-The evec2pca.perl program is for users who want to run the EIGENSTRAT
+The evec2pca.pl program is for users who want to run the EIGENSTRAT
stratification correction method on on output produced by the smartpca program.
It converts the .evec file produced by smartpca to the .pca file needed by
-EIGENSTRAT. However, if using the smartpca.perl wrapper, evec2pca.perl is
-called automatically so there is no need to separately run evec2pca.perl.
-See ../EIGENSTRAT/README for details on the smartpca.perl wrapper.
+EIGENSTRAT. However, if using the smartpca.pl wrapper, evec2pca.pl is
+called automatically so there is no need to separately run evec2pca.pl.
+See ../EIGENSTRAT/README for details on the smartpca.pl wrapper.
-The syntax of evec2pca.perl is
-../bin/evec2pca.perl k example.evec example.ind example.pca, where
+The syntax of evec2pca.pl is
+../bin/evec2pca.pl k example.evec example.ind example.pca, where
k is the number of principal components in example.evec file (e.g. 10)
example.evec is file of principal components produced by smartpca
example.ind is individual file
diff --git a/README b/README
old mode 100755
new mode 100644
index 87773a9..0166f7d
--- a/README
+++ b/README
@@ -1,8 +1,25 @@
-EIGENSOFT version 6.0.1, 12/12/14 (for Linux only)
+EIGENSOFT version 6.1.2, 6/27/16 (for Linux only)
-The EIGENSOFT package implements methods from the following 2 papers:
-Patterson et al. 2006 PLoS Genet 2:e190 (population structure)
-Price et al. 2006 Nat Genet 38:904-9 (EIGENSTRAT stratification correction)
+The EIGENSOFT package implements methods from the following 3 papers:
+Patterson et al. 2006 PLoS Genet (population structure)
+Price et al. 2006 Nat Genet (EIGENSTRAT stratification correction)
+Galinsky et al. 2016 Am J Hum Genet (FastPCA and PC-based selection statistic)
+
+NEW features of EIGENSOFT version 6.1.2 include:
+-- Updated license info to be GPL compliant required by linking the GSL
+
+NEW features of EIGENSOFT version 6.1.1 include:
+-- Minor bug fix to correctly merge version 6.0.2 and version 6.1 changes.
+-- pcaselection operates on evec files. Added examples.
+-- Backported twtable.c/h from EIGENSOFT 7alpha
+
+NEW features of EIGENSOFT version 6.1 include:
+-- The range finding step of PCA fastmode only scales the multiplied matrix,
+ as orthogonalization is unnecessary. This appears to improve accuracy.
+
+NEW features of EIGENSOFT version 6.0.2 include:
+-- Fixed Makefile and documentation to build eigenstrat properly
+-- Moved Tracy-Widom table into a header file for easier building
NEW features of EIGENSOFT version 6.0.1 include:
-- Minor bug fix which prevents smartpca from trying to print out eigenvalues
@@ -34,8 +51,8 @@ We have placed source code for all C executables in the src/ directory,
for users who wish to modify and recompile our programs. For example, to
recompile the eigenstrat program, type
"cd src"
-"make eigenstrat"
-"mv eigenstrat ../bin"
+"make eigensrc/eigenstrat"
+"mv eigensrc/eigenstrat ../bin"
Note that some of our software will only compile if your system has the
GSL + lapack + OpenBLAS packages installed.
@@ -69,14 +86,4 @@ EIGENSOFT was written by Nick Patterson, Alkes Price, Samuela Pollack,
Kevin Galinsky, Chris Chang, and Sasha Gusev.
We thank John Novembre and Mike Boursnell for code improvements, Matt Hanna
-for the first implementation of multi-threading, and Angela Yu for a bugfix.
-
-----------------------------
-SOFTWARE COPYRIGHT NOTICE AGREEMENT
-This software and its documentation are copyright (2010) by Harvard University
-and The Broad Institute. All rights are reserved. This software is supplied
-without any warranty or guaranteed support whatsoever. Neither Harvard
-University nor The Broad Institute can be responsible for its use, misuse, or
-functionality. The software may be freely copied for non-commercial purposes,
-provided this copyright notice is retained.
-
+for the first implementation of multi-threading, and Angela Yu for a bugfix.
diff --git a/bin/evec2pca-ped.perl b/bin/evec2pca-ped.pl
similarity index 100%
rename from bin/evec2pca-ped.perl
rename to bin/evec2pca-ped.pl
diff --git a/bin/evec2pca.perl b/bin/evec2pca.pl
similarity index 100%
rename from bin/evec2pca.perl
rename to bin/evec2pca.pl
diff --git a/bin/fixgreen b/bin/fixgreen
deleted file mode 100755
index df9b3fb..0000000
--- a/bin/fixgreen
+++ /dev/null
@@ -1,25 +0,0 @@
-#!/usr/local/bin/perl -w
-
-## a better green color for gnuplot (dark green)
-## and yellow
-
- ($IN) = @ARGV ;
- $T1 = "/tmp/t1fg.$$" ;
- system "cp $IN $IN.bak" ;
- open (FF, $IN) || die "can't open $IN\n" ;
- open (YY, ">$T1") || die "can't open $T1\n" ;
- foreach $line (<FF>) {
- chomp $line ;
- ($a) = split " ", $line ;
- if ($a eq "/LT1") {
- $line = "/LT1 { PL [4 dl 2 dl] .2 .4 0 DL } def" ;
- }
- if ($a eq "/LT5") {
- $line = "/LT5 { PL [4 dl 2 dl] 1 .8 0 DL } def" ;
- }
- print YY "$line\n" ;
- }
-close FF ;
-close YY ;
-system "cp $T1 $IN" ;
-unlink $T1 ;
diff --git a/bin/gc.perl b/bin/gc.pl
similarity index 100%
rename from bin/gc.perl
rename to bin/gc.pl
diff --git a/bin/ploteig b/bin/ploteig
deleted file mode 100755
index 5424479..0000000
--- a/bin/ploteig
+++ /dev/null
@@ -1,168 +0,0 @@
-#!/usr/local/bin/perl -w
-
-### ploteig -i eigfile -p pops -c a:b [-t title] [-s stem] [-o outfile] [-x] [-k] [-y] [-z sep] [-f fixgreen]
-use Getopt::Std ;
-use File::Basename ;
-
-## pops : separated -x = make postscript and pdf -z use another separator
-## -k keep intermediate files
-## NEW if pops is a file names are read one per line
-
-getopts('i:o:p:c:s:d:z:t:xkyf',\%opts) ;
-$postscmode = $opts{"x"} ;
-$oldkeystyle = $opts{"y"} ;
-$kflag = $opts{"k"} ;
-$keepflag = 1 if ($kflag) ;
-$keepflag = 1 unless ($postscmode) ;
-$dofixgreen = ( exists $opts{"f"} ? $opts{"f"} : 0 );
-
-$zsep = ":" ;
-if (defined $opts{"z"}) {
- $zsep = $opts{"z"} ;
- $zsep = "\+" if ($zsep eq "+") ;
-}
-
-$title = "" ;
-if (defined $opts{"t"}) {
- $title = $opts{"t"} ;
-}
-if (defined $opts{"i"}) {
- $infile = $opts{"i"} ;
-}
-else {
- usage() ;
- exit 0 ;
-}
-open (FF, $infile) || die "can't open $infile\n" ;
- at L = (<FF>) ;
-chomp @L ;
-$nf = 0 ;
-foreach $line (@L) {
- next if ($line =~ /\#/) ;
- @Z = split " ", $line ;
- $x = @Z ;
- $nf = $x if ($nf < $x) ;
-}
-printf "## number of fields: %d\n", $nf ;
-$popcol = $nf-1 ;
-
-
-if (defined $opts{"p"}) {
- $pops = $opts{"p"} ;
-}
-else {
- die "p parameter compulsory\n" ;
-}
-
-$popsname = setpops ($pops) ;
-print "$popsname\n" ;
-
-$c1 = 1; $c2 =2 ;
-if (defined $opts{"c"}) {
- $cols = $opts{"c"} ;
- ($c1, $c2) = split ":", $cols ;
- die "bad c param: $cols\n" unless (defined $cols) ;
-}
-
-$stem = "$infile.$c1:$c2" ;
-if (defined $opts{"s"}) {
- $stem = $opts{"s"} ;
-}
-$gnfile = "$stem.$popsname.xtxt" ;
-
-if (defined $opts{"o"}) {
- $gnfile = $opts{"o"} ;
-}
-
-
- at T = () ; ## trash
-open (GG, ">$gnfile") || die "can't open $gnfile\n" ;
-print GG "## " unless ($postscmode) ;
-print GG "set terminal postscript color\n" ;
-print GG "set title \"$title\" \n" ;
-print GG "set key outside\n" unless ($oldkeystyle) ;
-print GG "set xlabel \"eigenvector $c1\" \n" ;
-print GG "set ylabel \"eigenvector $c2\" \n" ;
-print GG "plot " ;
-$np = @P ;
-$lastpop = $P[$np-1] ;
-$d1 = $c1+1 ;
-$d2 = $c2+1 ;
-foreach $pop (@P) {
- $dfile = "$stem:$pop" ;
- push @T, $dfile ;
- print GG " \"$dfile\" using $d1:$d2 title \"$pop\" " ;
- print GG ", \\\n" unless ($pop eq $lastpop) ;
- open (YY, ">$dfile") || die "can't open $dfile\n" ;
- foreach $line (@L) {
- next if ($line =~ /\#/) ;
- @Z = split " ", $line ;
- next unless (defined $Z[$popcol]) ;
- next unless ($Z[$popcol] eq $pop) ;
- print YY "$line\n" ;
- }
- close YY ;
-}
-print GG "\n" ;
-print GG "## " if ($postscmode) ;
-print GG "pause 9999\n" ;
-close GG ;
-
-if ($postscmode) {
-$psfile = "$stem.ps" ;
-
- if ($gnfile =~ /xtxt/) {
- $psfile = $gnfile ;
- $psfile =~ s/xtxt/ps/ ;
- }
-system "gnuplot < $gnfile > $psfile" ;
-if ( $dofixgreen ) {
- system "fixgreen $psfile" ;
-}
-system "ps2pdf $psfile " ;
-}
-unlink (@T) unless $keepflag ;
-
-sub usage {
-
-print "ploteig -i eigfile -p pops -c a:b [-t title] [-s stem] [-o outfile] [-x] [-k]\n" ;
-print "-i eigfile input file first col indiv-id last col population\n" ;
-print "## as output by smartpca in outputvecs \n" ;
-print "-c a:b a, b columns to plot. 1:2 would be common and leading 2 eigenvectors\n" ;
-print "-p pops Populations to plot. : delimited. eg -p Bantu:San:French\n" ;
-print "## pops can also be a filename. List populations 1 per line\n" ;
-print "[-s stem] stem will start various output files\n" ;
-print "[-o ofile] ofile will be gnuplot control file. Should have xtxt suffix\n";
-print "[-x] make ps and pdf files\n" ;
-print "[-k] keep various intermediate files although -x set\n" ;
-print "## necessary if .xtxt file is to be hand edited\n" ;
-print "[-y] put key at top right inside box (old mode)\n" ;
-print "[-t] title (legend)\n" ;
-print "[-f] fix green and yellow colors\n";
-
-print "The xtxt file is a gnuplot file and can be easily hand edited. Intermediate files
-needed if you want to make your own plot\n" ;
-
-}
-sub setpops {
- my ($pops) = @_ ;
- local (@a, $d, $b, $e) ;
-
- if (-e $pops) {
- open (FF1, $pops) || die "can't open $pops\n" ;
- @P = () ;
- foreach $line (<FF1>) {
- ($a) = split " ", $line ;
- next unless (defined $a) ;
- next if ($a =~ /\#/) ;
- push @P, $a ;
- }
- $out = join ":", @P ;
- print "## pops: $out\n" ;
- ($b, $d , $e) = fileparse($pops) ;
- return $b ;
- }
- @P = split $zsep, $pops ;
- return $pops ;
-
-}
diff --git a/bin/smarteigenstrat.perl b/bin/smarteigenstrat.pl
similarity index 100%
rename from bin/smarteigenstrat.perl
rename to bin/smarteigenstrat.pl
diff --git a/bin/smartpca.perl b/bin/smartpca.pl
similarity index 100%
rename from bin/smartpca.perl
rename to bin/smartpca.pl
diff --git a/include/LICENSE.txt b/include/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/include/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/include/admutils.h b/include/admutils.h
index 98abc33..bf5b6e9 100644
--- a/include/admutils.h
+++ b/include/admutils.h
@@ -5,191 +5,258 @@
#ifndef ADMUTILS
-typedef struct {
+typedef struct
+{
char ID[IDSIZE];
- char *egroup ;
- char gender; /* 'M' or 'F' */
- double theta_mode; /* most likely theta on mesh */
+ char *egroup;
+ char gender; /* 'M' or 'F' */
+ double theta_mode; /* most likely theta on mesh */
double lambda_mode; /* mean of log10(lambda) from probability distribution */
- double Xtheta_mode; /* most likely theta on mesh */
- double Xlambda_mode; /* most likely lambda on mesh */
-
- int idnum ;
- int affstatus; /* affected status */
- int ignore ; /* YES => do not use */
- int flag ;
- double thetatrue ;
- double Xthetatrue ;
- double lambdatrue ;
- double Xlambdatrue ;
- double totgamms[3] ;
- double totscore ;
- double rawqval ;
- double qval ;
-} Indiv;
-
-typedef struct {
+ double Xtheta_mode; /* most likely theta on mesh */
+ double Xlambda_mode; /* most likely lambda on mesh */
+
+ int idnum;
+ int affstatus; /* affected status */
+ int ignore; /* YES => do not use */
+ int flag;
+ double thetatrue;
+ double Xthetatrue;
+ double lambdatrue;
+ double Xlambdatrue;
+ double totgamms[3];
+ double totscore;
+ double rawqval;
+ double qval;
+} Indiv;
+
+typedef struct
+{
char ID[IDSIZE];
int chrom;
- char cchrom[6] ;
+ char cchrom[6];
double genpos;
double physpos;
- double aa_cauc_freq; /* frequencies in ancestral pop to AA */
+ double aa_cauc_freq; /* frequencies in ancestral pop to AA */
double aa_af_freq;
- double cauc_freq; /* frequencies of variant allele */
+ double cauc_freq; /* frequencies of variant allele */
double af_freq;
- double cftrue ;
- double aftrue ;
- double aa_cftrue ;
- double aa_aftrue ;
- int markernum ; /* marker number */
- char *pbuff ;
- char *ebuff ; /* for random ethnic path */
- int isfake ; /* 1 if fake marker else 0 */
- int isrfake ;
-/* real marker treated as fake. Used for 2D scoring */
- int ignore ;
- int ngtypes ; /* number of gtypes */
- int *gtypes ;
- int af_nn[2] ;
- int cauc_nn[2] ;
- double *modelscores ;
- double *totmodelscores ;
- double score ;
- double weight ;
- double estgenpos ;
- double estdis ;
- double dis ;
- double esum ;
- double lsum ;
- double gpsum ;
- double gpnum ;
- void *pcupt ;
- int tagnumber ;
- char alleles[2] ;
- int chimpfudge ;
-} SNP;
-
-typedef struct {
- char ID[IDSIZE] ;
- Indiv *father ;
- Indiv *mother ;
- Indiv *child ;
- int findex ;
- int mindex ;
- int cindex ;
- int base ;
-} TRIO ;
+ double cftrue;
+ double aftrue;
+ double aa_cftrue;
+ double aa_aftrue;
+ int markernum; /* marker number */
+ char *pbuff;
+ char *ebuff; /* for random ethnic path */
+ int isfake; /* 1 if fake marker else 0 */
+ int isrfake;
+ /* real marker treated as fake. Used for 2D scoring */
+ int ignore;
+ int ngtypes; /* number of gtypes */
+ int *gtypes;
+ int af_nn[2];
+ int cauc_nn[2];
+ double *modelscores;
+ double *totmodelscores;
+ double score;
+ double weight;
+ double estgenpos;
+ double estdis;
+ double dis;
+ double esum;
+ double lsum;
+ double gpsum;
+ double gpnum;
+ void *pcupt;
+ int tagnumber;
+ char alleles[2];
+ int chimpfudge;
+} SNP;
+
+typedef struct
+{
+ char ID[IDSIZE];
+ Indiv *father;
+ Indiv *mother;
+ Indiv *child;
+ int findex;
+ int mindex;
+ int cindex;
+ int base;
+} TRIO;
// ?index into original Indiv array. base is work variable used in phasetrio to store init index in new array
-typedef struct {
- char gname[IDSIZE] ;
- SNP **snpm ;
- Indiv **indivm ;
- int numsnps;
- int numindivs ;
- int rlen ;
- int fdes ;
- int snpindex ;
- unsigned char *buff ;
-} genofile ;
-
-typedef struct {
- double xd[4] ;
- double xc[9] ;
- double ap1 ;
- double ap2 ;
- double cp1 ;
- double cp2 ;
- double rpowersum ;
- double crpowersum ;
- double gammasum[2] ;
- double gammanum[2] ;
- int pubfmodern ;
-} SNPMC ;
+typedef struct
+{
+ char gname[IDSIZE];
+ SNP **snpm;
+ Indiv **indivm;
+ int numsnps;
+ int numindivs;
+ int rlen;
+ int fdes;
+ int snpindex;
+ unsigned char *buff;
+} genofile;
+
+typedef struct
+{
+ double xd[4];
+ double xc[9];
+ double ap1;
+ double ap2;
+ double cp1;
+ double cp2;
+ double rpowersum;
+ double crpowersum;
+ double gammasum[2];
+ double gammanum[2];
+ int pubfmodern;
+} SNPMC;
// gammasum for cases/controls
#endif
#define ADMUTILS
-void loadstats(FILE *statsfile, Indiv *indiv_array, int *numindivs);
-void loadXstats(FILE *Xstatsfile, Indiv *indiv_array, int numindivs, int *numloaded);
-
-void sett1(double *tt, double theta, int numstates) ;
-void sett1r(double *tt, double theta, int numstate, double risks) ;
-void gettln(SNP *cupt, Indiv *indx,
- double *ptheta, double *plambda, int *pnumstates, int *pignore) ;
+void
+loadstats (FILE *statsfile, Indiv *indiv_array, int *numindivs);
+void
+loadXstats (FILE *Xstatsfile, Indiv *indiv_array, int numindivs, int *numloaded);
-void puttln(SNP *cupt, Indiv *indx,
- double theta, double lambda) ;
+void
+sett1 (double *tt, double theta, int numstates);
+void
+sett1r (double *tt, double theta, int numstate, double risks);
+void
+gettln (SNP *cupt, Indiv *indx, double *ptheta, double *plambda,
+ int *pnumstates, int *pignore);
+void
+puttln (SNP *cupt, Indiv *indx, double theta, double lambda);
/* UTILITY FUNCTIONS */
-int countcol (char *fname);
-int countcolumns (FILE *fp);
-
-void fataly(const char *name);
-int compare_doubles (const void *a, const void *b);
-
-void pcheck (char *name, char x) ;
-void printm(double **M, int numstates) ;
-int numvalids(Indiv *indx, SNP **snpmarkers, int fc, int lc) ;
-void gethpos(int *fc, int *lc, SNP **snpm, int numsnps,
- int xchrom, int lo, int hi) ;
-int numvalidgtypes(SNP *cupt) ;
-double malefreq(Indiv **indivmarkers, int numindivs) ;
-int isimatch(int a, int b) ;
-void makedir(char *dirname) ;
-int indxindex(char **namelist, int len, char *strid) ;
-int indindex(Indiv **indivmarkers, int numindivs, char *indid) ;
-int snpindex(SNP **snpmarkers, int numsnps, char *snpid) ;
-void inddupcheck(Indiv **indivmarkers, int numindivs) ;
-void freesnpindex() ;
-int ignoresnp(SNP *cupt) ;
-double entrop(double *a, int n) ;
-double xxlog2(double t) ;
-void testnan(double *a, int n) ;
-void hap2dip(SNP *cupt) ;
-void flipalleles(SNP *cupt) ;
-void flipalleles_phased(SNP *cupt) ;
-int getgtypes(SNP *cupt, int k) ;
-void putgtypes(SNP *cupt, int k, int val) ;
-int getep(SNP *cupt, int k) ;
-void putep(SNP *cupt, int k, int val) ;
-int hasharr(char **xarr, int nxarr) ;
-void wbuff(unsigned char *buff, int num, int g) ;
-int rbuff(unsigned char *buff, int num) ;
-int ridfile(char *fname) ;
-double hwcheck(SNP *cupt, double *cc) ;
-double hwcheckx(SNP *cupt, Indiv **indm, double *cc) ;
-void cntit(double *xc, SNP *cupt1, SNP *cupt2) ;
+int
+countcol (char *fname);
+int
+countcolumns (FILE *fp);
+
+void
+fataly (const char *name);
+int
+compare_doubles (const void *a, const void *b);
+
+void
+pcheck (char *name, char x);
+void
+printm (double **M, int numstates);
+int
+numvalids (Indiv *indx, SNP **snpmarkers, int fc, int lc);
+void
+gethpos (int *fc, int *lc, SNP **snpm, int numsnps, int xchrom, int lo, int hi);
+int
+numvalidgtypes (SNP *cupt);
+double
+malefreq (Indiv **indivmarkers, int numindivs);
+int
+isimatch (int a, int b);
+void
+makedir (char *dirname);
+int
+indxindex (char **namelist, int len, char *strid);
+int
+indindex (Indiv **indivmarkers, int numindivs, char *indid);
+int
+snpindex (SNP **snpmarkers, int numsnps, char *snpid);
+void
+inddupcheck (Indiv **indivmarkers, int numindivs);
+void
+freesnpindex ();
+int
+ignoresnp (SNP *cupt);
+double
+entrop (double *a, int n);
+double
+xxlog2 (double t);
+void
+testnan (double *a, int n);
+void
+hap2dip (SNP *cupt);
+void
+flipalleles (SNP *cupt);
+void
+flipalleles_phased (SNP *cupt);
+int
+getgtypes (SNP *cupt, int k);
+void
+putgtypes (SNP *cupt, int k, int val);
+int
+getep (SNP *cupt, int k);
+void
+putep (SNP *cupt, int k, int val);
+int
+hasharr (char **xarr, int nxarr);
+void
+wbuff (unsigned char *buff, int num, int g);
+int
+rbuff (unsigned char *buff, int num);
+int
+ridfile (char *fname);
+double
+hwcheck (SNP *cupt, double *cc);
+double
+hwcheckx (SNP *cupt, Indiv **indm, double *cc);
+void
+cntit (double *xc, SNP *cupt1, SNP *cupt2);
// dup routines
-void setfastdupnum(int num) ;
-void setfastdupthresh(double thresh, double kill) ;
-void killxhets(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs) ;
-void fastdupcheck(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs) ;
-int grabgtypes(int *gtypes, SNP *cupt, int numindivs) ;
-int kcode(int *w, int len, int base) ;
-void cdup(SNP **snpm, Indiv **indm, int nsnp, int *buff, int lbuff) ;
-void printdup(SNP **snpm, int nsnp, Indiv *inda, Indiv *indb, int nmatch, int nnomatch);
-void killdup(Indiv *inda, Indiv *indb, SNP **snpm, int nsnp) ;
-double kurtosis(double *a, int n) ;
-int getlist(char *name, char **list) ;
-void printvers(char *progname, char *vers) ;
-int numvalidind(Indiv **indivmarkers, int numind) ;
-void numvalidgtallind(int *x, SNP **snpm, int numsnps, int numind) ;
-int numvalidgtind(SNP **snpm, int numsnps, int ind) ;
-int numvalidgt(Indiv **indivmarkers, SNP *cupt) ;
-int numvalidgtx(Indiv **indivmarkers, SNP *cupt, int affst) ;
-int isxmale(SNP *cupt, Indiv *indx) ;
-
-void printmatz(double *ww, char **eglist, int n) ;
-void printmatz5(double *ww, char **eglist, int n) ;
-void printmatz10(double *ww, char **eglist, int n) ;
-char *get3(char *ss) ;
-char *getshort(char *ss, int n) ;
+void
+setfastdupnum (int num);
+void
+setfastdupthresh (double thresh, double kill);
+void
+killxhets (SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs);
+void
+fastdupcheck (SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs);
+int
+grabgtypes (int *gtypes, SNP *cupt, int numindivs);
+int
+kcode (int *w, int len, int base);
+void
+cdup (SNP **snpm, Indiv **indm, int nsnp, int *buff, int lbuff);
+void
+printdup (SNP **snpm, int nsnp, Indiv *inda, Indiv *indb, int nmatch,
+ int nnomatch);
+void
+killdup (Indiv *inda, Indiv *indb, SNP **snpm, int nsnp);
+double
+kurtosis (double *a, int n);
+int
+getlist (char *name, char **list);
+void
+printvers (char *progname, char *vers);
+int
+numvalidind (Indiv **indivmarkers, int numind);
+void
+numvalidgtallind (int *x, SNP **snpm, int numsnps, int numind);
+int
+numvalidgtind (SNP **snpm, int numsnps, int ind);
+int
+numvalidgt (Indiv **indivmarkers, SNP *cupt);
+int
+numvalidgtx (Indiv **indivmarkers, SNP *cupt, int affst);
+int
+isxmale (SNP *cupt, Indiv *indx);
+void
+printmatz (double *ww, char **eglist, int n);
+void
+printmatz5 (double *ww, char **eglist, int n);
+void
+printmatz10 (double *ww, char **eglist, int n);
+char *
+get3 (char *ss);
+char *
+getshort (char *ss, int n);
#undef max
#define max(A,B) ((A) > (B) ? (A) : (B))
diff --git a/include/backup/kjg_fpca.h b/include/backup/kjg_fpca.h
deleted file mode 100644
index 571a38e..0000000
--- a/include/backup/kjg_fpca.h
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
- * kjg_fpca.h
- *
- * Created on: Apr 28, 2014
- * Author: Kevin
- */
-
-#ifndef KJG_FPCA_H_
-#define KJG_FPCA_H_
-
-#include <gsl/gsl_matrix.h>
-
-#include "admutils.h"
-
-extern size_t KJG_FPCA_ROWS; // number of rows to process at once
-
-void kjg_fastpca(SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- size_t K, size_t L, size_t I,
- double *eigenvals, double *eigenvecs);
-
-/**
- * FastPCA blanczos step
- *
- * @param *X compressed genotype matrix (MxN)
- * @param *M array of SNP means
- * @param *G random norm matrix (NxL)
- * @param *H matrix to store product (MxIL)
- */
-
-void kjg_fpca_blanczos(SNP **snpmarkers, Indiv **indivmarkers, size_t numsnps, size_t numindivs, double *M, gsl_matrix* G,
- gsl_matrix* H);
-
-/**
- * Multiply G2 = XT*H = XT*X*G1
- *
- * @param *X compressed genotype matrix
- * @param *M array of SNP means
- * @param *G1 some matrix
- * @param *H intermediate matrix
- * @param *G2 next matrix
- */
-
-void kjg_fpca_XTXG(SNP **snpmarkers, Indiv **indivmarkers, size_t numsnps, size_t numindivs, double *M, gsl_matrix *G1,
- gsl_matrix *H, gsl_matrix *G2);
-
-/**
- * Multiply H = X*G
- *
- * @param *X compressed genotype matrix
- * @param *M array of SNP means
- * @param *G some matrix
- * @param *H another matrix
- */
-
-void kjg_fpca_XG(SNP **snpmarkers, Indiv **indivmarkers, size_t numsnps, size_t numindivs, double *M, gsl_matrix *G,
- gsl_matrix *H);
-
-/**
- * Multiply G = XT*H
- *
- * @param *X compressed genotype matrix
- * @param *M array of SNP means
- * @param *H some matrix
- * @param *G another matrix
- */
-
-void kjg_fpca_XTH(SNP **snpmarkers, Indiv **indivmarkers, size_t numsnps, size_t numindivs, double *M, gsl_matrix *H,
- gsl_matrix *G);
-
-#endif /* KJG_FPCA_H_ */
diff --git a/include/backup/kjg_geno.h b/include/backup/kjg_geno.h
deleted file mode 100644
index 7e358db..0000000
--- a/include/backup/kjg_geno.h
+++ /dev/null
@@ -1,137 +0,0 @@
-/*
- * kjg_geno.h
- *
- * Created on: Jul 31, 2013
- * Author: kjg063
- */
-
-#ifndef KJG_GENO_H_
-#define KJG_GENO_H_
-
-#include <stddef.h>
-#include <stdint.h>
-
-#include "admutils.h"
-
-/**
- * Compute the mean of the genotypes.
- *
- * @param *x array of genotypes
- * @param n number of subjects
- * @return mean of the genotypes whose assays didn't fail
- */
-double kjg_geno_mean(uint8_t *x, size_t n);
-
-/**
- * Normalize genotypes.
- *
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success or failure (-1)
- */
-int kjg_geno_normalize(uint8_t *x, double *y, size_t n);
-
-/**
- * Normalize genotypes when you already have the mean.
- *
- * @param m mean of the genotypes
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success or failure (-1)
- */
-int kjg_geno_normalize_m(double m, uint8_t* x, double* y,
- size_t n);
-
-/**
- * Remap genotypes values to doubles.
- *
- * @param s array of genotype mappings
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success (0) or zero-good genos (1)
- */
-void kjg_geno_remap(double s[4], uint8_t* x, double* y,
- size_t n);
-
-/**
- * Compute the normalization lookup array.
- *
- * @param m genotype mean
- * @param s[4] array to store the scale
- * @return success (0) or zero-good genos (1)
- */
-int kjg_geno_normalization_lookup(double m, double s[4]);
-
-/**
- * Unack genotype array
- *
- * @param *x where to unpack genotypes
- * @param *y packed genotypes
- * @param n number of genotypes
- */
-
-void kjg_geno_unpack(uint8_t* x,
- SNP *cupt, Indiv **indivmarkers,
- size_t numindivs);
-
-/**
- * Get a row in the geno object
- *
- * @param *x unpacked genotype row
- * @param *g geno object
- * @param i row index
- */
-
-void kjg_geno_get_row(uint8_t* x,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- size_t i);
-
-/**
- * Get a row and normalize it.
- *
- * @param *x unpacked genotype row
- * @param *y normalized genotype row
- * @param *g geno struct
- * @param *M mean array
- * @param i row index
- */
-
-void kjg_geno_get_normalized_row(uint8_t* x, double* y,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M, size_t i);
-
-/**
- * Get multiple row and normalized rows
- *
- * @param *x unpacked genotype row (will hold last one)
- * @param *Y normalized genotype rows
- * @param *g geno struct
- * @param *M mean array
- * @param i row index
- * @param r number of rows to get
- * @return number of rows retrieved
- */
-
-
-size_t kjg_geno_get_normalized_rows(uint8_t* x, double* Y,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M, size_t i, size_t r);
-
-/**
- * Compute the mean genotype of all SNPs in the geno object
- *
- * @param *g geno object
- * @param *M array to store means
- */
-
-void kjg_geno_row_means(SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M);
-
-#endif /* KJG_GENO_H_ */
diff --git a/include/backup/kjg_gsl.h b/include/backup/kjg_gsl.h
deleted file mode 100644
index 4be1c22..0000000
--- a/include/backup/kjg_gsl.h
+++ /dev/null
@@ -1,73 +0,0 @@
-/*
- * kjg_gsl.h
- *
- * Created on: Aug 1, 2013
- * Author: kjg063
- */
-
-#ifndef KJG_GSL_H_
-#define KJG_GSL_H_
-
-#include <gsl/gsl_matrix.h>
-#include <gsl/gsl_vector.h>
-#include <gsl/gsl_rng.h>
-
-/**
- * Prints the matrix tab-delimited
- *
- * @param *stream file pointer to print output
- * @param *m gsl_matrix to print
- * @param *template character template for fprintf
- */
-
-void kjg_gsl_matrix_fprintf(FILE* stream, gsl_matrix* m, char* template);
-
-
-/**
- * Print the eigenvalues and then eigenvectors below
- *
- * @param *stream file pointer to print output
- * @param *eval eigenvalues
- * @param *evec eigenvectors
- * @param *template character template for fprintf */
-
-void kjg_gsl_evec_fprintf(FILE* stream, gsl_vector* eval, gsl_matrix* evec, char* template);
-
-void kjg_gsl_matrix_fscanf(FILE* stream, gsl_matrix* m);
-int kjg_gsl_evec_fscanf(FILE* stream, gsl_vector* eval, gsl_matrix* evec);
-
-/**
- * Initialize random number generation.
- */
-
-gsl_rng *kjg_gsl_rng_init();
-
-/**
- * Initialize the matrix with random unit gaussians
- *
- * @param *m matrix to be set
- * @param *r random number generator
- */
-
-void kjg_gsl_matrix_set_ran_ugaussian(gsl_matrix* m, gsl_rng* r);
-
-/**
- * Normalize the matrix so the frobenius norm is M*N
- *
- * @param *m matrix to normalize
- * @return if error
- */
-
-int kjg_gsl_matrix_frobenius_normalize(gsl_matrix* m);
-
-/**
- * Calculate the norm of a matrix
- *
- * @param norm type of norm to return, see lapack dlange
- * @param *m matrix to find norm of
- * @return norm
- */
-
-double kjg_gsl_dlange(char norm, gsl_matrix* m);
-
-#endif /* KJG_GSL_H_ */
diff --git a/include/badpairs.h b/include/badpairs.h
index be2342e..7f0a8b8 100644
--- a/include/badpairs.h
+++ b/include/badpairs.h
@@ -1,15 +1,23 @@
#include <nicklib.h>
#include "admutils.h"
-void dobadpairs(char *badpairsname, SNP **snpm, int numsnps) ;
-void dogood(char *goodsnpname, SNP **snpm, int numsnps) ;
-void getsnpsc(char *snpscname, SNP **snpm, int numsnps) ;
-int killsnps(Indiv **indivmarkers, SNP **snpmarkers, int numsnps, int mincasenum) ;
-void loadbadpsc(SNP **snpm, int numsnps, int rmode, char *gname) ;
-
-double entrop(double *a, int n) ;
-double xxlog2(double t) ;
-double mutx(double *dd) ;
-double mutxx(double *dd, int m , int n) ;
+void
+dobadpairs (char *badpairsname, SNP **snpm, int numsnps);
+void
+dogood (char *goodsnpname, SNP **snpm, int numsnps);
+void
+getsnpsc (char *snpscname, SNP **snpm, int numsnps);
+int
+killsnps (Indiv **indivmarkers, SNP **snpmarkers, int numsnps, int mincasenum);
+void
+loadbadpsc (SNP **snpm, int numsnps, int rmode, char *gname);
+double
+entrop (double *a, int n);
+double
+xxlog2 (double t);
+double
+mutx (double *dd);
+double
+mutxx (double *dd, int m, int n);
diff --git a/include/egsubs.h b/include/egsubs.h
index 6b824f6..8c58cdc 100644
--- a/include/egsubs.h
+++ b/include/egsubs.h
@@ -1,9 +1,14 @@
#include "admutils.h"
-
-int makeeglist(char **eglist, int maxnumeg, Indiv **indivmarkers, int numindivs) ;
-int mkeglist(Indiv **indm, int numindivs, char **eglist) ;
-void seteglist(Indiv **indm, int nindiv, char *eglistname) ;
-void seteglistv(Indiv **indm, int nindiv, char *eglistname, int val) ;
-int loadlist(char **list, char *listname) ;
-int loadlist_type(char **list, char *listname, int *ztypes, int off) ;
+int
+makeeglist (char **eglist, int maxnumeg, Indiv **indivmarkers, int numindivs);
+int
+mkeglist (Indiv **indm, int numindivs, char **eglist);
+void
+seteglist (Indiv **indm, int nindiv, char *eglistname);
+void
+seteglistv (Indiv **indm, int nindiv, char *eglistname, int val);
+int
+loadlist (char **list, char *listname);
+int
+loadlist_type (char **list, char *listname, int *ztypes, int off);
diff --git a/include/eigqpsubs.h b/include/eigqpsubs.h
index 579fd1c..f274d8f 100644
--- a/include/eigqpsubs.h
+++ b/include/eigqpsubs.h
@@ -16,180 +16,276 @@
#include "regsubs.h"
#include "egsubs.h"
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+int
+loadsnpx (SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+vadjust (double *rr, int n, double *pmean);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolx (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+void
+getrawcol (int *rawcol, SNP *cupt, int *xindex, int nrows);
+void
+getrawcolx (int **ccc, SNP *cupt, int *xindex, int nrows, Indiv **indm);
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-int loadsnpx(SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int vadjust(double *rr, int n, double *pmean) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolx(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-void getrawcol(int *rawcol, SNP *cupt, int *xindex, int nrows) ;
-void getrawcolx(int **ccc, SNP *cupt, int *xindex, int nrows, Indiv **indm) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+void
+setmiss (SNP **snpm, int numsnps);
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
-double dofst(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int mode) ;
+double
+dofst (double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int mode);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double divcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+divcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double fst(SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int type1, int type2, double *psd, int mode) ;
+double
+fst (SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols, int type1,
+ int type2, double *psd, int mode);
-double dofstx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg) ;
+double
+dofstx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg);
-void fstcolyy(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg) ;
+void
+fstcolyy (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int numeg);
-double fstcoly(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcoly (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double fstx(SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int type1, int type2, double *psd) ;
+double
+fstx (SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols, int type1,
+ int type2, double *psd);
void
- setplimit(Indiv **indivmarkers, int numindivs,
- char **eglist, int numeg, int plimit) ;
+setplimit (Indiv **indivmarkers, int numindivs, char **eglist, int numeg,
+ int plimit);
-void loadzdata(double **zdata, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *ncolx, int *tagnums) ;
+void
+loadzdata (double **zdata, SNP **xsnplist, int *xindex, int *xtypes, int nrows,
+ int ncols, int numeg, int *ncolx, int *tagnums);
-void getpdata(int *rawcol, double *pm, double *pn, int *xtypes, int nrows, int numeg) ;
+void
+getpdata (int *rawcol, double *pm, double *pn, int *xtypes, int nrows,
+ int numeg);
-void getrscore(double *rscore, double *rho, double **zz,
- int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks) ;
+void
+getrscore (double *rscore, double *rho, double **zz, int ncols, int a, int b,
+ int c, int d, int numeg, int *blabels, int nblocks);
-double qcorr(double **zz, double *rho,
- int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks) ;
-void xcopy(int rp[4], int a , int b, int c, int d) ;
-void settsc(int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3]) ;
-void printsc(int pat[3][4], double tscore[3], char **eglist, double ymin) ;
-double dohzg(double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg) ;
+double
+qcorr (double **zz, double *rho, int ncols, int a, int b, int c, int d,
+ int numeg, int *blabels, int nblocks);
+void
+xcopy (int rp[4], int a, int b, int c, int d);
+void
+settsc (int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3]);
+void
+printsc (int pat[3][4], double tscore[3], char **eglist, double ymin);
+double
+dohzg (double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg);
-void dohzgjack(double *fstest, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *bcols, int nblocks) ;
+void
+dohzgjack (double *fstest, double *fstsig, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, int *bcols,
+ int nblocks);
-void gethscore(double *hscore, double *scores,
- int a, int b, int c, int d, int numeg) ;
+void
+gethscore (double *hscore, double *scores, int a, int b, int c, int d,
+ int numeg);
-double qhdiff(double *scores, int a, int b, int c, int d, int numeg) ;
-void setblocks(int *block, int *bsize, int *nblock, SNP **snpm, int numsnps, double blocklen) ;
-int numblocks(SNP **snpm, int numsnps, double blocklen) ;
-void setmgpos(SNP **snpm, int numsnps, double *maxgdis) ;
-void setgfromp(SNP **snpm, int numsnps) ;
-void wjackest(double *est, double *sig, double mean, double *jmean, double *jwt, int n) ;
-void wjackvest(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g) ;
-void corrwjack(double *xrho, double *xsig, double *z1, double *z2, int n, int *bcols, int nblocks);
-double crho(double *stats) ;
+double
+qhdiff (double *scores, int a, int b, int c, int d, int numeg);
+void
+setblocks (int *block, int *bsize, int *nblock, SNP **snpm, int numsnps,
+ double blocklen);
+int
+numblocks (SNP **snpm, int numsnps, double blocklen);
+void
+setmgpos (SNP **snpm, int numsnps, double *maxgdis);
+void
+setgfromp (SNP **snpm, int numsnps);
+void
+wjackest (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int n);
+void
+wjackvest (double *vest, double *var, int d, double *mean, double **jmean,
+ double *jwt, int g);
+void
+corrwjack (double *xrho, double *xsig, double *z1, double *z2, int n,
+ int *bcols, int nblocks);
+double
+crho (double *stats);
-void ndfst5(double *zzest, double *zzsig, double **zn, double **zd, int ncols, int *bcols, int nblocks) ;
-void regestit(double *ans, double *xn, double *xd) ;
+void
+ndfst5 (double *zzest, double *zzsig, double **zn, double **zd, int ncols,
+ int *bcols, int nblocks);
+void
+regestit (double *ans, double *xn, double *xd);
-void setwt(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
- int *xindex, int *xtypes, char * outpop, char **eglist, int numeg) ;
-void countg(int *rawcol, int **cc, int *xtypes, int n, int ntypes) ;
-void dohzgjack(double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *bcols, int nblocks) ;
+void
+setwt (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
+ int *xindex, int *xtypes, char * outpop, char **eglist, int numeg);
+void
+countg (int *rawcol, int **cc, int *xtypes, int n, int ntypes);
+void
+dohzgjack (double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int *bcols, int nblocks);
-void setbcols(SNP **xsnplist, int ncols, int *bcols) ;
+void
+setbcols (SNP **xsnplist, int ncols, int *bcols);
double
-dofstnum(double *fst, double *fstnum, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks) ;
+dofstnum (double *fst, double *fstnum, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks);
double
-dofstnumx(double *fst, double *fstnum, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, Indiv **indm, int fstmode) ;
+dofstnumx (double *fst, double *fstnum, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, Indiv **indm, int fstmode);
void
-dof3(double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode) ;
+dof3 (double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode);
void
-dof4(double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode) ;
-
-void f3y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+dof4 (double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode);
-void f4y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4) ;
+void
+f3y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3);
-void f3sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+void
+f4y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3, int type4);
-void f2sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+void
+f3sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3);
-void f4yx(double *estn, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4) ;
+void
+f2sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3);
-void f3yy(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg) ;
+void
+f4yx (double *estn, SNP *cupt, Indiv **indm, int *xindex, int *xtypes,
+ int nrows, int type1, int type2, int type3, int type4);
-int f3yyx(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg, Indiv **indm) ;
+void
+f3yy (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows, int numeg);
+int
+f3yyx (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows,
+ int numeg, Indiv **indm);
-double doadmlin(double *jest, double *jsig, double *zlin, double *var,
- SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, Indiv **indm) ;
+double
+doadmlin (double *jest, double *jsig, double *zlin, double *var, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, double scale, Indiv **indm);
-double estmix(double *z, double *f3, int n) ;
+double
+estmix (double *z, double *f3, int n);
-void bump2(double *x, int a, int b, int n, double val) ;
-double dump2(double *x, int a, int b, int n) ;
-void bump3(double *x, int a, int b, int c, int n, double val) ;
-double dump3(double *x, int a, int b, int c, int n) ;
+void
+bump2 (double *x, int a, int b, int n, double val);
+double
+dump2 (double *x, int a, int b, int n);
+void
+bump3 (double *x, int a, int b, int c, int n, double val);
+double
+dump3 (double *x, int a, int b, int c, int n);
-void bump4(double *x, int a, int b, int c, int d, int n, double val) ;
-void bump4x(double *x, int a, int b, int c, int d, int n, double val) ; // all 4 images
-void set4x(double *x, int a, int b, int c, int d, int n, double val) ;
-void set4(double *x, int a, int b, int c, int d, int n, double val) ; // all 4 images
+void
+bump4 (double *x, int a, int b, int c, int d, int n, double val);
+void
+bump4x (double *x, int a, int b, int c, int d, int n, double val); // all 4 images
+void
+set4x (double *x, int a, int b, int c, int d, int n, double val);
+void
+set4 (double *x, int a, int b, int c, int d, int n, double val); // all 4 images
-double dump4(double *x, int a, int b, int c, int d, int n) ;
-double ff3val(double *ff3, int a, int b, int c, int n) ;
+double
+dump4 (double *x, int a, int b, int c, int d, int n);
+double
+ff3val (double *ff3, int a, int b, int c, int n);
// graph stuff
-int loadgraph(char *readit, char ***peglist) ;
-void getgmix(double **vmix, int *lmix, int *nmix) ;
-void putgmix(double **vmix) ;
-void getpwts(double *pwts, int *nrows, int *nedge) ;
-void getenames(char **enames) ;
-void setsimp(double *ww, int n) ;
-int edgenum(char *edgename) ;
-void addvertex(char *vertname) ;
-void supergetvnames(char **vnames, int *xvlist, int nxvlist) ;
-void superalloc(int **xv, int ***xe, int ***adv, int **aedge) ;
-void supersetup(int *xvlist, int *nxvlist, int **xelist, int *nxelist, int **admixv, int *admixedge, int *nxalist) ;
-void supereglist(int *eelist) ;
-void supergetvar(double *svar,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superputvals(double **admixw, double *elen,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superest(double *xmean, double *xvar, double *svar, double *yobs, int nxvlist, int *elist) ;
-void supergetvals(double **admixw, double *elen,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superreest(double *s2,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void setadmfix(char *fixname) ;
+int
+loadgraph (char *readit, char ***peglist);
+void
+getgmix (double **vmix, int *lmix, int *nmix);
+void
+putgmix (double **vmix);
+void
+getpwts (double *pwts, int *nrows, int *nedge);
+void
+getenames (char **enames);
+void
+setsimp (double *ww, int n);
+int
+edgenum (char *edgename);
+void
+addvertex (char *vertname);
+void
+supergetvnames (char **vnames, int *xvlist, int nxvlist);
+void
+superalloc (int **xv, int ***xe, int ***adv, int **aedge);
+void
+supersetup (int *xvlist, int *nxvlist, int **xelist, int *nxelist, int **admixv,
+ int *admixedge, int *nxalist);
+void
+supereglist (int *eelist);
+void
+supergetvar (double *svar, int *xvlist, int nxvlist, int **xelist, int nxelist,
+ int **admixv, int *admixedge, int nxalist);
+void
+superputvals (double **admixw, double *elen, int *xvlist, int nxvlist,
+ int **xelist, int nxelist, int **admixv, int *admixedge,
+ int nxalist);
+void
+superest (double *xmean, double *xvar, double *svar, double *yobs, int nxvlist,
+ int *elist);
+void
+supergetvals (double **admixw, double *elen, int *xvlist, int nxvlist,
+ int **xelist, int nxelist, int **admixv, int *admixedge,
+ int nxalist);
+void
+superreest (double *s2, int *xvlist, int nxvlist, int **xelist, int nxelist,
+ int **admixv, int *admixedge, int nxalist);
+void
+setadmfix (char *fixname);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
diff --git a/include/eigsubs.h b/include/eigsubs.h
index 8ce321b..c0a1a36 100644
--- a/include/eigsubs.h
+++ b/include/eigsubs.h
@@ -3,14 +3,21 @@
#include <math.h>
#include <nicklib.h>
-void eigvals(double *mat, double *evals, int n) ;
-void eigvecs(double *mat, double *evals, double *evecs, int n) ;
-void eigb(double *lam, double *a, double *b, int n) ;
-void eigc(double *lam, double *a, double *b, int n) ;
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
+void
+eigvals (double *mat, double *evals, int n);
+void
+eigvecs (double *mat, double *evals, double *evecs, int n);
+void
+eigb (double *lam, double *a, double *b, int n);
+void
+eigc (double *lam, double *a, double *b, int n);
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
-typedef struct {
- int vecno ;
- double score ;
-} OUTLINFO ;;
+typedef struct
+{
+ int vecno;
+ double score;
+} OUTLINFO;
+;
diff --git a/include/exclude.h b/include/exclude.h
index deadd5c..2e34722 100644
--- a/include/exclude.h
+++ b/include/exclude.h
@@ -8,9 +8,13 @@
/* file name parameter : xregionname */
/* HW filter parameter : nhwfilter (-1 means no-filter) */
/* maximum number of regions : 1000
- closed intervals in physical position include endpoints */
+ closed intervals in physical position include endpoints */
/* read file and set ignore flag for SNPs */
-void excluderegions(char *xregionname, SNP **snps, int nsnps, char *deletesnpoutname);
-void hwfilter(SNP **snps, int nsnps, int nindiv, double nhwfilter, char *deletesnpoutname);
+void
+excluderegions (char *xregionname, SNP **snps, int nsnps,
+ char *deletesnpoutname);
+void
+hwfilter (SNP **snps, int nsnps, int nindiv, double nhwfilter,
+ char *deletesnpoutname);
#endif
diff --git a/include/getpars.h b/include/getpars.h
index f1b47b0..87cacdd 100644
--- a/include/getpars.h
+++ b/include/getpars.h
@@ -1,23 +1,38 @@
-typedef struct {
- int numpars ;
- FILE *fx ;
- char **ppars ;
- char **pdata ;
-} phandle ;
+typedef struct
+{
+ int numpars;
+ FILE *fx;
+ char **ppars;
+ char **pdata;
+} phandle;
-void writepars(phandle *pp) ;
-void closepars(phandle *pp) ;
-phandle *openpars(char *fname) ;
+void
+writepars (phandle *pp);
+void
+closepars (phandle *pp);
+phandle *
+openpars (char *fname);
-int getstring(phandle *pp, char *parname, char **kret) ;
-int getint(phandle *pp, char *parname, int *kret) ;
-int getints(phandle *pp, char *parname, int *aint, int nint) ;
-int getintss(phandle *pp, char *parname, int *aint, int *xint) ;
+int
+getstring (phandle *pp, char *parname, char **kret);
+int
+getint (phandle *pp, char *parname, int *kret);
+int
+getints (phandle *pp, char *parname, int *aint, int nint);
+int
+getintss (phandle *pp, char *parname, int *aint, int *xint);
-int getdbl(phandle *pp, char *parname, double *dbl) ;
-int getdbls(phandle *pp, char *parname, double *dbl, int ndbl) ;
-int getdblss(phandle *pp, char *parname, double *dbl, int *ndbl) ;
-int subst(char *outstr, char *instr, char *ins, char *outs) ;
-void dostrsub(phandle *pp) ;
-int upstring (char *ss) ;
-void subcolon(char *ss) ;
+int
+getdbl (phandle *pp, char *parname, double *dbl);
+int
+getdbls (phandle *pp, char *parname, double *dbl, int ndbl);
+int
+getdblss (phandle *pp, char *parname, double *dbl, int *ndbl);
+int
+subst (char *outstr, char *instr, char *ins, char *outs);
+void
+dostrsub (phandle *pp);
+int
+upstring (char *ss);
+void
+subcolon (char *ss);
diff --git a/include/globals.h b/include/globals.h
index 14a8cee..0ac5f4e 100644
--- a/include/globals.h
+++ b/include/globals.h
@@ -2,7 +2,7 @@
#define _GLOBALS_
int numchrom = 22;
-int fancynorm=YES, verbose=NO, plotmode=NO, outnum = -1 ;
+int fancynorm = YES, verbose = NO, plotmode = NO, outnum = -1;
#endif
diff --git a/include/gval.h b/include/gval.h
index 5290ddb..2f6763f 100644
--- a/include/gval.h
+++ b/include/gval.h
@@ -1,4 +1,22 @@
-void setgval(SNP **xsnps, int nrows, Indiv **indivmarkers, int numindivs, int *xindex, int *xtypes, int ncols) ;
-void unsetgval() ;
-int getgval(int row, int col, double *val) ;
-int getggval(int indindx, int col, double *val) ;
+void
+setgval (SNP ** xsnps, int nrows, Indiv ** indivmarkers, int numindivs,
+ int *xindex, int *xtypes, int ncols);
+void
+unsetgval ();
+int
+getgval (int row, int col, double *val);
+int
+getggval (int indindx, int col, double *val);
+
+void
+set_ind_mask ();
+
+size_t
+get_nrows ();
+size_t
+get_ncols ();
+
+void
+kjg_geno_get_normalized_row (const size_t snp_index, double* y);
+size_t
+kjg_geno_get_normalized_rows (const size_t i, const size_t r, double* Y);
diff --git a/include/kjg_fpca.h b/include/kjg_fpca.h
index ed36845..3fea7a9 100644
--- a/include/kjg_fpca.h
+++ b/include/kjg_fpca.h
@@ -19,7 +19,8 @@ extern size_t KJG_FPCA_ROWS; // number of rows to process at once
* @param I iterations to do exponentiation
*/
-void kjg_fpca (size_t K, size_t L, size_t I, double *eval, double *evec);
+void
+kjg_fpca (size_t K, size_t L, size_t I, double *eval, double *evec);
/** Multiplies B=X*A1 and A2 = XT*B = XT*X*A1
* @param *A1 some matrix
@@ -27,20 +28,23 @@ void kjg_fpca (size_t K, size_t L, size_t I, double *eval, double *evec);
* @param *A2 next matrix
*/
-void kjg_fpca_XTXA (const gsl_matrix * A1, gsl_matrix * B, gsl_matrix * A2);
+void
+kjg_fpca_XTXA (const gsl_matrix * A1, gsl_matrix * B, gsl_matrix * A2);
/** Multiplies B = X*A
* @param *A some matrix
* @param *B another matrix
*/
-void kjg_fpca_XA (const gsl_matrix * A, gsl_matrix * B);
+void
+kjg_fpca_XA (const gsl_matrix * A, gsl_matrix * B);
/** Multiplies A = XT*B
* @param *B some matrix
* @param *A another matrix
*/
-void kjg_fpca_XTB (const gsl_matrix * B, gsl_matrix * A);
+void
+kjg_fpca_XTB (const gsl_matrix * B, gsl_matrix * A);
#endif /* KJG_FPCA_H_ */
diff --git a/include/kjg_geno.h b/include/kjg_geno.h
deleted file mode 100644
index 7e358db..0000000
--- a/include/kjg_geno.h
+++ /dev/null
@@ -1,137 +0,0 @@
-/*
- * kjg_geno.h
- *
- * Created on: Jul 31, 2013
- * Author: kjg063
- */
-
-#ifndef KJG_GENO_H_
-#define KJG_GENO_H_
-
-#include <stddef.h>
-#include <stdint.h>
-
-#include "admutils.h"
-
-/**
- * Compute the mean of the genotypes.
- *
- * @param *x array of genotypes
- * @param n number of subjects
- * @return mean of the genotypes whose assays didn't fail
- */
-double kjg_geno_mean(uint8_t *x, size_t n);
-
-/**
- * Normalize genotypes.
- *
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success or failure (-1)
- */
-int kjg_geno_normalize(uint8_t *x, double *y, size_t n);
-
-/**
- * Normalize genotypes when you already have the mean.
- *
- * @param m mean of the genotypes
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success or failure (-1)
- */
-int kjg_geno_normalize_m(double m, uint8_t* x, double* y,
- size_t n);
-
-/**
- * Remap genotypes values to doubles.
- *
- * @param s array of genotype mappings
- * @param *x array of genotypes
- * @param *y array to put scaled genotypes
- * @param n number of subjects
- * @return success (0) or zero-good genos (1)
- */
-void kjg_geno_remap(double s[4], uint8_t* x, double* y,
- size_t n);
-
-/**
- * Compute the normalization lookup array.
- *
- * @param m genotype mean
- * @param s[4] array to store the scale
- * @return success (0) or zero-good genos (1)
- */
-int kjg_geno_normalization_lookup(double m, double s[4]);
-
-/**
- * Unack genotype array
- *
- * @param *x where to unpack genotypes
- * @param *y packed genotypes
- * @param n number of genotypes
- */
-
-void kjg_geno_unpack(uint8_t* x,
- SNP *cupt, Indiv **indivmarkers,
- size_t numindivs);
-
-/**
- * Get a row in the geno object
- *
- * @param *x unpacked genotype row
- * @param *g geno object
- * @param i row index
- */
-
-void kjg_geno_get_row(uint8_t* x,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- size_t i);
-
-/**
- * Get a row and normalize it.
- *
- * @param *x unpacked genotype row
- * @param *y normalized genotype row
- * @param *g geno struct
- * @param *M mean array
- * @param i row index
- */
-
-void kjg_geno_get_normalized_row(uint8_t* x, double* y,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M, size_t i);
-
-/**
- * Get multiple row and normalized rows
- *
- * @param *x unpacked genotype row (will hold last one)
- * @param *Y normalized genotype rows
- * @param *g geno struct
- * @param *M mean array
- * @param i row index
- * @param r number of rows to get
- * @return number of rows retrieved
- */
-
-
-size_t kjg_geno_get_normalized_rows(uint8_t* x, double* Y,
- SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M, size_t i, size_t r);
-
-/**
- * Compute the mean genotype of all SNPs in the geno object
- *
- * @param *g geno object
- * @param *M array to store means
- */
-
-void kjg_geno_row_means(SNP **snpmarkers, Indiv **indivmarkers,
- size_t numsnps, size_t numindivs,
- double* M);
-
-#endif /* KJG_GENO_H_ */
diff --git a/include/kjg_gsl.h b/include/kjg_gsl.h
index 97e2343..3209be8 100644
--- a/include/kjg_gsl.h
+++ b/include/kjg_gsl.h
@@ -17,8 +17,8 @@
* @param *template character template for fprintf
*/
-void kjg_gsl_matrix_fprintf (FILE * stream, gsl_matrix * m,
- const char *template);
+void
+kjg_gsl_matrix_fprintf (FILE * stream, gsl_matrix * m, const char *template);
/**
* Prints the eigenvalues and then eigenvectors below
@@ -27,9 +27,9 @@ void kjg_gsl_matrix_fprintf (FILE * stream, gsl_matrix * m,
* @param *evec eigenvectors
* @param *template character template for fprintf */
-void kjg_gsl_evec_fprintf (FILE * stream,
- gsl_vector * eval,
- gsl_matrix * evec, const char *template);
+void
+kjg_gsl_evec_fprintf (FILE * stream, gsl_vector * eval, gsl_matrix * evec,
+ const char *template);
/**
* Reads a matrix
@@ -37,7 +37,8 @@ void kjg_gsl_evec_fprintf (FILE * stream,
* @param *m matrix to store
*/
-void kjg_gsl_matrix_fscanf (FILE * stream, gsl_matrix * m);
+void
+kjg_gsl_matrix_fscanf (FILE * stream, gsl_matrix * m);
/**
* Reads an evec
@@ -46,13 +47,15 @@ void kjg_gsl_matrix_fscanf (FILE * stream, gsl_matrix * m);
* @param *evec eigenvectors matrix
*/
-int kjg_gsl_evec_fscanf (FILE * stream, gsl_vector * eval, gsl_matrix * evec);
+int
+kjg_gsl_evec_fscanf (FILE * stream, gsl_vector * eval, gsl_matrix * evec);
/**
* Initializes random number generation.
*/
-gsl_rng *kjg_gsl_rng_init ();
+gsl_rng *
+kjg_gsl_rng_init ();
/**
* Initializes the matrix with random unit gaussians
@@ -60,14 +63,16 @@ gsl_rng *kjg_gsl_rng_init ();
* @param *r random number generator
*/
-void kjg_gsl_ran_ugaussian_pair (const gsl_rng * r, double x[2]);
+void
+kjg_gsl_ran_ugaussian_pair (const gsl_rng * r, double x[2]);
/** Fills a matrix with unit Gaussian random variates
* @param *r random number generator
* @param *m matrix to be filled
*/
-void kjg_gsl_ran_ugaussian_matrix (const gsl_rng * r, gsl_matrix * m);
+void
+kjg_gsl_ran_ugaussian_matrix (const gsl_rng * r, gsl_matrix * m);
/**
* Normalizes the matrix so the Frobenius norm is M*N
@@ -75,7 +80,8 @@ void kjg_gsl_ran_ugaussian_matrix (const gsl_rng * r, gsl_matrix * m);
* @return if error
*/
-int kjg_gsl_matrix_frobenius_normalize (gsl_matrix * m);
+int
+kjg_gsl_matrix_frobenius_normalize (gsl_matrix * m);
/**
* Calculates the norm of a matrix
@@ -84,14 +90,16 @@ int kjg_gsl_matrix_frobenius_normalize (gsl_matrix * m);
* @return norm
*/
-double kjg_gsl_dlange (const char norm, const gsl_matrix * m);
+double
+kjg_gsl_dlange (const char norm, const gsl_matrix * m);
/**
* Performs the QR decomposition on the matrix and return Q in the matrix
* @param *m matrix to orthogonalize
*/
-void kjg_gsl_matrix_QR (gsl_matrix * m);
+void
+kjg_gsl_matrix_QR (gsl_matrix * m);
/**
* Calls LAPACK dgeqrf and return R and compacted Q matrix
@@ -100,7 +108,8 @@ void kjg_gsl_matrix_QR (gsl_matrix * m);
* @return LAPACK return
*/
-int kjg_gsl_dgeqrf (gsl_matrix * m, gsl_vector * tau);
+int
+kjg_gsl_dgeqrf (gsl_matrix * m, gsl_vector * tau);
/**
* Calls LAPACK dorgqr to extract Q matrix
@@ -108,7 +117,8 @@ int kjg_gsl_dgeqrf (gsl_matrix * m, gsl_vector * tau);
* @param *tau see LAPACK documentation
* @return LAPACK return
*/
-int kjg_gsl_dorgqr (gsl_matrix * m, gsl_vector * tau);
+int
+kjg_gsl_dorgqr (gsl_matrix * m, gsl_vector * tau);
/**
* Calls LAPACK dgesvd, keeping u (in m) and s, discarding v^T
@@ -116,6 +126,7 @@ int kjg_gsl_dorgqr (gsl_matrix * m, gsl_vector * tau);
* @param *s entries of the diagonal matrix
* @return LAPACK return
*/
-int kjg_gsl_SVD (gsl_matrix * M, gsl_matrix * V, gsl_vector * S);
+int
+kjg_gsl_SVD (gsl_matrix * M, gsl_matrix * V, gsl_vector * S);
#endif /* KJG_GSL_H_ */
diff --git a/include/lapacke.h b/include/lapacke.h
deleted file mode 100644
index e0367a2..0000000
--- a/include/lapacke.h
+++ /dev/null
@@ -1,16305 +0,0 @@
-/*****************************************************************************
- Copyright (c) 2010, Intel Corp.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice,
- this list of conditions and the following disclaimer.
- * Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- * Neither the name of Intel Corporation nor the names of its contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
- THE POSSIBILITY OF SUCH DAMAGE.
-******************************************************************************
-* Contents: Native C interface to LAPACK
-* Author: Intel Corporation
-* Generated November, 2011
-*****************************************************************************/
-
-#ifndef _LAPACKE_H_
-#define _LAPACKE_H_
-
-/*
-* Turn on HAVE_LAPACK_CONFIG_H to redefine C-LAPACK datatypes
-*/
-#ifdef HAVE_LAPACK_CONFIG_H
-#include "lapacke_config.h"
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif /* __cplusplus */
-
-#include <stdlib.h>
-
-#ifndef lapack_int
-#define lapack_int int
-#endif
-
-#ifndef lapack_logical
-#define lapack_logical lapack_int
-#endif
-
-/* Complex types are structures equivalent to the
-* Fortran complex types COMPLEX(4) and COMPLEX(8).
-*
-* One can also redefine the types with his own types
-* for example by including in the code definitions like
-*
-* #define lapack_complex_float std::complex<float>
-* #define lapack_complex_double std::complex<double>
-*
-* or define these types in the command line:
-*
-* -Dlapack_complex_float="std::complex<float>"
-* -Dlapack_complex_double="std::complex<double>"
-*/
-
-#ifndef LAPACK_COMPLEX_CUSTOM
-
-/* Complex type (single precision) */
-#ifndef lapack_complex_float
-#include <complex.h>
-#define lapack_complex_float float _Complex
-#endif
-
-#ifndef lapack_complex_float_real
-#define lapack_complex_float_real(z) (creal(z))
-#endif
-
-#ifndef lapack_complex_float_imag
-#define lapack_complex_float_imag(z) (cimag(z))
-#endif
-
-lapack_complex_float lapack_make_complex_float( float re, float im );
-
-/* Complex type (double precision) */
-#ifndef lapack_complex_double
-#include <complex.h>
-#define lapack_complex_double double _Complex
-#endif
-
-#ifndef lapack_complex_double_real
-#define lapack_complex_double_real(z) (creal(z))
-#endif
-
-#ifndef lapack_complex_double_imag
-#define lapack_complex_double_imag(z) (cimag(z))
-#endif
-
-lapack_complex_double lapack_make_complex_double( double re, double im );
-
-#endif
-
-#ifndef LAPACKE_malloc
-#define LAPACKE_malloc( size ) malloc( size )
-#endif
-#ifndef LAPACKE_free
-#define LAPACKE_free( p ) free( p )
-#endif
-
-#define LAPACK_C2INT( x ) (lapack_int)(*((float*)&x ))
-#define LAPACK_Z2INT( x ) (lapack_int)(*((double*)&x ))
-
-#define LAPACK_ROW_MAJOR 101
-#define LAPACK_COL_MAJOR 102
-
-#define LAPACK_WORK_MEMORY_ERROR -1010
-#define LAPACK_TRANSPOSE_MEMORY_ERROR -1011
-
-/* Callback logical functions of one, two, or three arguments are used
-* to select eigenvalues to sort to the top left of the Schur form.
-* The value is selected if function returns TRUE (non-zero). */
-
-typedef lapack_logical (*LAPACK_S_SELECT2) ( const float*, const float* );
-typedef lapack_logical (*LAPACK_S_SELECT3)
- ( const float*, const float*, const float* );
-typedef lapack_logical (*LAPACK_D_SELECT2) ( const double*, const double* );
-typedef lapack_logical (*LAPACK_D_SELECT3)
- ( const double*, const double*, const double* );
-
-typedef lapack_logical (*LAPACK_C_SELECT1) ( const lapack_complex_float* );
-typedef lapack_logical (*LAPACK_C_SELECT2)
- ( const lapack_complex_float*, const lapack_complex_float* );
-typedef lapack_logical (*LAPACK_Z_SELECT1) ( const lapack_complex_double* );
-typedef lapack_logical (*LAPACK_Z_SELECT2)
- ( const lapack_complex_double*, const lapack_complex_double* );
-
-#include "lapacke_mangling.h"
-
-#define LAPACK_lsame LAPACK_GLOBAL(lsame,LSAME)
-lapack_logical LAPACK_lsame( char* ca, char* cb,
- lapack_int lca, lapack_int lcb );
-
-/* C-LAPACK function prototypes */
-
-lapack_int LAPACKE_sbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt, float* q,
- lapack_int* iq );
-lapack_int LAPACKE_dbdsdc( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq );
-
-lapack_int LAPACKE_sbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c, lapack_int ldc );
-lapack_int LAPACKE_dbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt, lapack_int ldvt,
- double* u, lapack_int ldu, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zbdsqr( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_sdisna( char job, lapack_int m, lapack_int n, const float* d,
- float* sep );
-lapack_int LAPACKE_ddisna( char job, lapack_int m, lapack_int n,
- const double* d, double* sep );
-
-lapack_int LAPACKE_sgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq, float* pt,
- lapack_int ldpt, float* c, lapack_int ldc );
-lapack_int LAPACKE_dgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* pt, lapack_int ldpt,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zgbbrd( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* pt, lapack_int ldpt,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv, float anorm,
- float* rcond );
-lapack_int LAPACKE_dgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond );
-lapack_int LAPACKE_cgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zgbcon( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgbequ( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax );
-
-lapack_int LAPACKE_sgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgbequb( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab, lapack_int ldab,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb, lapack_int ldafb,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgbrfs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* afb, lapack_int ldafb,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const float* ab, lapack_int ldab,
- const float* afb, lapack_int ldafb,
- const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zgbrfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const lapack_complex_double* ab,
- lapack_int ldab, const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_sgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbsv( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_dgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-lapack_int LAPACKE_cgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* rpivot );
-lapack_int LAPACKE_zgbsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* rpivot );
-
-lapack_int LAPACKE_sgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_cgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zgbsvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_sgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_dgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_cgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgbtrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbtrs( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* scale,
- lapack_int m, float* v, lapack_int ldv );
-lapack_int LAPACKE_dgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* scale,
- lapack_int m, double* v, lapack_int ldv );
-lapack_int LAPACKE_cgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* scale,
- lapack_int m, lapack_complex_float* v,
- lapack_int ldv );
-lapack_int LAPACKE_zgebak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* scale,
- lapack_int m, lapack_complex_double* v,
- lapack_int ldv );
-
-lapack_int LAPACKE_sgebal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- float* scale );
-lapack_int LAPACKE_dgebal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, lapack_int* ilo, lapack_int* ihi,
- double* scale );
-lapack_int LAPACKE_cgebal( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi, float* scale );
-lapack_int LAPACKE_zgebal( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi, double* scale );
-
-lapack_int LAPACKE_sgebrd( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup );
-lapack_int LAPACKE_dgebrd( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup );
-lapack_int LAPACKE_cgebrd( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* d,
- float* e, lapack_complex_float* tauq,
- lapack_complex_float* taup );
-lapack_int LAPACKE_zgebrd( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* d,
- double* e, lapack_complex_double* tauq,
- lapack_complex_double* taup );
-
-lapack_int LAPACKE_sgecon( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond );
-lapack_int LAPACKE_dgecon( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond );
-lapack_int LAPACKE_cgecon( int matrix_order, char norm, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond );
-lapack_int LAPACKE_zgecon( int matrix_order, char norm, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond );
-
-lapack_int LAPACKE_sgeequ( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgeequ( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequ( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgeequ( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax );
-
-lapack_int LAPACKE_sgeequb( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgeequb( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequb( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_zgeequb( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgees( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs );
-lapack_int LAPACKE_dgees( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs );
-lapack_int LAPACKE_cgees( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs );
-lapack_int LAPACKE_zgees( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs );
-
-lapack_int LAPACKE_sgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense, lapack_int n,
- float* a, lapack_int lda, lapack_int* sdim,
- float* wr, float* wi, float* vs, lapack_int ldvs,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense, lapack_int n,
- double* a, lapack_int lda, lapack_int* sdim,
- double* wr, double* wi, double* vs, lapack_int ldvs,
- double* rconde, double* rcondv );
-lapack_int LAPACKE_cgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_zgeesx( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* wr,
- float* wi, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_dgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* wr,
- double* wi, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_cgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_zgeev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr );
-
-lapack_int LAPACKE_sgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv );
-lapack_int LAPACKE_dgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- double* abnrm, double* rconde, double* rcondv );
-lapack_int LAPACKE_cgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde,
- float* rcondv );
-lapack_int LAPACKE_zgeevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int ldvl, lapack_complex_double* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv );
-
-lapack_int LAPACKE_sgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau );
-lapack_int LAPACKE_dgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau );
-lapack_int LAPACKE_cgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* tau );
-lapack_int LAPACKE_zgehrd( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* sva,
- float* u, lapack_int ldu, float* v, lapack_int ldv,
- float* stat, lapack_int* istat );
-lapack_int LAPACKE_dgejsv( int matrix_order, char joba, char jobu, char jobv,
- char jobr, char jobt, char jobp, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* sva,
- double* u, lapack_int ldu, double* v, lapack_int ldv,
- double* stat, lapack_int* istat );
-
-lapack_int LAPACKE_sgelq2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgelq2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgelq2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgelq2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgelqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgelqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgelqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgelqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgels( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-lapack_int LAPACKE_cgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelsd( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-lapack_int LAPACKE_cgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelss( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_dgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank );
-lapack_int LAPACKE_cgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank );
-lapack_int LAPACKE_zgelsy( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* jpvt, double rcond,
- lapack_int* rank );
-
-lapack_int LAPACKE_sgeqlf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqlf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqlf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqlf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqp3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau );
-lapack_int LAPACKE_dgeqp3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau );
-lapack_int LAPACKE_cgeqp3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqp3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqpf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau );
-lapack_int LAPACKE_dgeqpf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau );
-lapack_int LAPACKE_cgeqpf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqpf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqr2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqr2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqr2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqr2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgeqrfp( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_cgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgerfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* r,
- const float* c, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zgerfsx( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* r,
- const double* c, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sgerqf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dgerqf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_cgerqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zgerqf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_sgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda, float* s,
- float* u, lapack_int ldu, float* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_dgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda, double* s,
- double* u, lapack_int ldu, double* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt );
-lapack_int LAPACKE_zgesdd( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt );
-
-lapack_int LAPACKE_sgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter );
-lapack_int LAPACKE_zcgesv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_int* iter );
-
-lapack_int LAPACKE_sgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* superb );
-lapack_int LAPACKE_dgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* superb );
-lapack_int LAPACKE_cgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt, float* superb );
-lapack_int LAPACKE_zgesvd( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt, double* superb );
-
-lapack_int LAPACKE_sgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, float* a, lapack_int lda,
- float* sva, lapack_int mv, float* v, lapack_int ldv,
- float* stat );
-lapack_int LAPACKE_dgesvj( int matrix_order, char joba, char jobu, char jobv,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, lapack_int mv,
- double* v, lapack_int ldv, double* stat );
-
-lapack_int LAPACKE_sgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_dgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-lapack_int LAPACKE_cgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* rpivot );
-lapack_int LAPACKE_zgesvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* rpivot );
-
-lapack_int LAPACKE_sgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zgesvxx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sgetf2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetf2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetf2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetf2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetrf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetrf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetri( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dgetri( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_cgetri( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zgetri( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgetrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* lscale,
- const float* rscale, lapack_int m, float* v,
- lapack_int ldv );
-lapack_int LAPACKE_dggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* lscale,
- const double* rscale, lapack_int m, double* v,
- lapack_int ldv );
-lapack_int LAPACKE_cggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const float* lscale,
- const float* rscale, lapack_int m,
- lapack_complex_float* v, lapack_int ldv );
-lapack_int LAPACKE_zggbak( int matrix_order, char job, char side, lapack_int n,
- lapack_int ilo, lapack_int ihi, const double* lscale,
- const double* rscale, lapack_int m,
- lapack_complex_double* v, lapack_int ldv );
-
-lapack_int LAPACKE_sggbal( int matrix_order, char job, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale );
-lapack_int LAPACKE_dggbal( int matrix_order, char job, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale );
-lapack_int LAPACKE_cggbal( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale );
-lapack_int LAPACKE_zggbal( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale );
-
-lapack_int LAPACKE_sgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_S_SELECT3 selctg, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- lapack_int* sdim, float* alphar, float* alphai,
- float* beta, float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr );
-lapack_int LAPACKE_dgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_D_SELECT3 selctg, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int ldvsl,
- double* vsr, lapack_int ldvsr );
-lapack_int LAPACKE_cgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_C_SELECT2 selctg, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vsl,
- lapack_int ldvsl, lapack_complex_float* vsr,
- lapack_int ldvsr );
-lapack_int LAPACKE_zgges( int matrix_order, char jobvsl, char jobvsr, char sort,
- LAPACK_Z_SELECT2 selctg, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr );
-
-lapack_int LAPACKE_sggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv );
-lapack_int LAPACKE_cggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_zggesx( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_dggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_cggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr );
-lapack_int LAPACKE_zggev( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr );
-
-lapack_int LAPACKE_sggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm,
- float* rconde, float* rcondv );
-lapack_int LAPACKE_dggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv );
-lapack_int LAPACKE_cggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
- float* lscale, float* rscale, float* abnrm,
- float* bbnrm, float* rconde, float* rcondv );
-lapack_int LAPACKE_zggevx( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* abnrm, double* bbnrm,
- double* rconde, double* rcondv );
-
-lapack_int LAPACKE_sggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* d, float* x, float* y );
-lapack_int LAPACKE_dggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* d, double* x, double* y );
-lapack_int LAPACKE_cggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* d,
- lapack_complex_float* x, lapack_complex_float* y );
-lapack_int LAPACKE_zggglm( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* d,
- lapack_complex_double* x, lapack_complex_double* y );
-
-lapack_int LAPACKE_sgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z, lapack_int ldz );
-lapack_int LAPACKE_dgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_cgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zgghrd( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* c, float* d, float* x );
-lapack_int LAPACKE_dgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda, double* b,
- lapack_int ldb, double* c, double* d, double* x );
-lapack_int LAPACKE_cgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* c,
- lapack_complex_float* d, lapack_complex_float* x );
-lapack_int LAPACKE_zgglse( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* c,
- lapack_complex_double* d, lapack_complex_double* x );
-
-lapack_int LAPACKE_sggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub );
-lapack_int LAPACKE_dggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub );
-lapack_int LAPACKE_cggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub );
-lapack_int LAPACKE_zggqrf( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub );
-
-lapack_int LAPACKE_sggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda, float* taua,
- float* b, lapack_int ldb, float* taub );
-lapack_int LAPACKE_dggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub );
-lapack_int LAPACKE_cggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub );
-lapack_int LAPACKE_zggrqf( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub );
-
-lapack_int LAPACKE_sggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork );
-lapack_int LAPACKE_dggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv, double* q,
- lapack_int ldq, lapack_int* iwork );
-lapack_int LAPACKE_cggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* alpha, float* beta, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* v,
- lapack_int ldv, lapack_complex_float* q,
- lapack_int ldq, lapack_int* iwork );
-lapack_int LAPACKE_zggsvd( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int n, lapack_int p,
- lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l, float* u,
- lapack_int ldu, float* v, lapack_int ldv, float* q,
- lapack_int ldq );
-lapack_int LAPACKE_dggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, lapack_int* k,
- lapack_int* l, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq );
-lapack_int LAPACKE_cggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zggsvp( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double tola, double tolb, lapack_int* k,
- lapack_int* l, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* v,
- lapack_int ldv, lapack_complex_double* q,
- lapack_int ldq );
-
-lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl,
- const float* d, const float* du, const float* du2,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl,
- const double* d, const double* du, const double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-lapack_int LAPACKE_cgtcon( char norm, lapack_int n,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zgtcon( char norm, lapack_int n,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* dlf,
- const double* df, const double* duf,
- const double* du2, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgtrfs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* dl, lapack_complex_float* d,
- lapack_complex_float* du, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgtsv( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* dl, lapack_complex_double* d,
- lapack_complex_double* du, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- lapack_complex_float* dlf, lapack_complex_float* df,
- lapack_complex_float* duf, lapack_complex_float* du2,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_zgtsvx( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- lapack_complex_double* dlf,
- lapack_complex_double* df,
- lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_sgttrf( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_dgttrf( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv );
-lapack_int LAPACKE_cgttrf( lapack_int n, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_zgttrf( lapack_int n, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv );
-
-lapack_int LAPACKE_sgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl, const float* d,
- const float* du, const float* du2,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl, const double* d,
- const double* du, const double* du2,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_cgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgttrs( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* q, lapack_int ldq, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* x, lapack_int ldx );
-lapack_int LAPACKE_zhbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* bb, lapack_int ldbb,
- lapack_complex_double* x, lapack_int ldx );
-
-lapack_int LAPACKE_chbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_chbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- lapack_complex_double* q, lapack_int ldq, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zhbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq );
-
-lapack_int LAPACKE_checon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zhecon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_cheequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zheequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_cheev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_zheev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_cheevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_zheevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* w );
-
-lapack_int LAPACKE_cheevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_zheevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz );
-
-lapack_int LAPACKE_cheevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_zheevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chegst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhegst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chegv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w );
-lapack_int LAPACKE_zhegv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* w );
-
-lapack_int LAPACKE_chegvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w );
-lapack_int LAPACKE_zhegvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* w );
-
-lapack_int LAPACKE_chegvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhegvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_cherfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zherfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_cherfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zherfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_chesv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhesv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chesvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zhesvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_chesvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zhesvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_chetrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda, float* d,
- float* e, lapack_complex_float* tau );
-lapack_int LAPACKE_zhetrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda, double* d,
- double* e, lapack_complex_double* tau );
-
-lapack_int LAPACKE_chetrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zhetrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_chetri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zhetri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_chetrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, float alpha,
- const lapack_complex_float* a, lapack_int lda,
- float beta, lapack_complex_float* c );
-lapack_int LAPACKE_zhfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, double alpha,
- const lapack_complex_double* a, lapack_int lda,
- double beta, lapack_complex_double* c );
-
-lapack_int LAPACKE_shgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* t, lapack_int ldt,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz );
-lapack_int LAPACKE_dhgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* t, lapack_int ldt,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_chgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhgeqz( int matrix_order, char job, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zhpcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_chpev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_float* ap, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_zhpevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_complex_double* ap, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chpgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* ap,
- const lapack_complex_float* bp );
-lapack_int LAPACKE_zhpgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* ap,
- const lapack_complex_double* bp );
-
-lapack_int LAPACKE_chpgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zhpgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_chpgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_complex_float* bp,
- float vl, float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_zhpgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zhprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_chpsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhpsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chpsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zhpsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_chptrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, float* d, float* e,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zhptrd( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, double* d, double* e,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_chptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zhptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_chptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_zhptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, const lapack_int* ipiv );
-
-lapack_int LAPACKE_chptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_shsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n, const float* h,
- lapack_int ldh, float* wr, const float* wi,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_dhsein( int matrix_order, char job, char eigsrc, char initv,
- lapack_logical* select, lapack_int n,
- const double* h, lapack_int ldh, double* wr,
- const double* wi, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, lapack_int* ifaill,
- lapack_int* ifailr );
-lapack_int LAPACKE_chsein( int matrix_order, char job, char eigsrc, char initv,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int ldvl, lapack_complex_float* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_zhsein( int matrix_order, char job, char eigsrc, char initv,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int ldvl, lapack_complex_double* vr,
- lapack_int ldvr, lapack_int mm, lapack_int* m,
- lapack_int* ifaill, lapack_int* ifailr );
-
-lapack_int LAPACKE_shseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, float* h,
- lapack_int ldh, float* wr, float* wi, float* z,
- lapack_int ldz );
-lapack_int LAPACKE_dhseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi, double* h,
- lapack_int ldh, double* wr, double* wi, double* z,
- lapack_int ldz );
-lapack_int LAPACKE_chseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w, lapack_complex_float* z,
- lapack_int ldz );
-lapack_int LAPACKE_zhseqr( int matrix_order, char job, char compz, lapack_int n,
- lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_clacgv( lapack_int n, lapack_complex_float* x,
- lapack_int incx );
-lapack_int LAPACKE_zlacgv( lapack_int n, lapack_complex_double* x,
- lapack_int incx );
-
-lapack_int LAPACKE_slacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dlacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_clacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zlacpy( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_zlag2c( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_float* sa, lapack_int ldsa );
-
-lapack_int LAPACKE_slag2d( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_dlag2s( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa );
-
-lapack_int LAPACKE_clag2z( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* sa, lapack_int ldsa,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_dlagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_clagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_zlagge( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* iseed );
-
-float LAPACKE_slamch( char cmach );
-double LAPACKE_dlamch( char cmach );
-
-float LAPACKE_slange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda );
-double LAPACKE_dlange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda );
-float LAPACKE_clange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda );
-double LAPACKE_zlange( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda );
-
-float LAPACKE_clanhe( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda );
-double LAPACKE_zlanhe( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda );
-
-float LAPACKE_slansy( int matrix_order, char norm, char uplo, lapack_int n,
- const float* a, lapack_int lda );
-double LAPACKE_dlansy( int matrix_order, char norm, char uplo, lapack_int n,
- const double* a, lapack_int lda );
-float LAPACKE_clansy( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda );
-double LAPACKE_zlansy( int matrix_order, char norm, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda );
-
-float LAPACKE_slantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda );
-double LAPACKE_dlantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda );
-float LAPACKE_clantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const lapack_complex_float* a,
- lapack_int lda );
-double LAPACKE_zlantr( int matrix_order, char norm, char uplo, char diag,
- lapack_int m, lapack_int n, const lapack_complex_double* a,
- lapack_int lda );
-
-
-lapack_int LAPACKE_slarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dlarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_clarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zlarfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_slarfg( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau );
-lapack_int LAPACKE_dlarfg( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau );
-lapack_int LAPACKE_clarfg( lapack_int n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zlarfg( lapack_int n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_slarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dlarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_clarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* tau,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zlarft( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* tau,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_slarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dlarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_clarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_float* v,
- lapack_complex_float tau, lapack_complex_float* c,
- lapack_int ldc, lapack_complex_float* work );
-lapack_int LAPACKE_zlarfx( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_double* v,
- lapack_complex_double tau, lapack_complex_double* c,
- lapack_int ldc, lapack_complex_double* work );
-
-lapack_int LAPACKE_slarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- float* x );
-lapack_int LAPACKE_dlarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- double* x );
-lapack_int LAPACKE_clarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- lapack_complex_float* x );
-lapack_int LAPACKE_zlarnv( lapack_int idist, lapack_int* iseed, lapack_int n,
- lapack_complex_double* x );
-
-lapack_int LAPACKE_slaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta, double* a,
- lapack_int lda );
-lapack_int LAPACKE_claset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- lapack_complex_float beta, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_zlaset( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- lapack_complex_double beta, lapack_complex_double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d );
-lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d );
-
-lapack_int LAPACKE_slaswp( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_dlaswp( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_claswp( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int k1, lapack_int k2, const lapack_int* ipiv,
- lapack_int incx );
-lapack_int LAPACKE_zlaswp( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int k1, lapack_int k2, const lapack_int* ipiv,
- lapack_int incx );
-
-lapack_int LAPACKE_slatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, float* d,
- lapack_int mode, float cond, float dmax,
- lapack_int kl, lapack_int ku, char pack, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, double* d,
- lapack_int mode, double cond, double dmax,
- lapack_int kl, lapack_int ku, char pack, double* a,
- lapack_int lda );
-lapack_int LAPACKE_clatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, float* d,
- lapack_int mode, float cond, float dmax,
- lapack_int kl, lapack_int ku, char pack,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlatms( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym, double* d,
- lapack_int mode, double cond, double dmax,
- lapack_int kl, lapack_int ku, char pack,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slauum( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlauum( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_clauum( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlauum( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_sopgtr( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq );
-lapack_int LAPACKE_dopgtr( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq );
-
-lapack_int LAPACKE_sopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* ap,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dopmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* ap,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau );
-
-lapack_int LAPACKE_sorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau );
-lapack_int LAPACKE_dorgrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau );
-
-lapack_int LAPACKE_sorgtr( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const float* tau );
-lapack_int LAPACKE_dorgtr( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const double* tau );
-
-lapack_int LAPACKE_sormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dormhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda, const float* tau,
- float* c, lapack_int ldc );
-lapack_int LAPACKE_dormrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda, const double* tau,
- double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc );
-lapack_int LAPACKE_dormrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* tau, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dormtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* tau, double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_spbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond );
-lapack_int LAPACKE_dpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double anorm, double* rcond );
-lapack_int LAPACKE_cpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float anorm, float* rcond );
-lapack_int LAPACKE_zpbcon( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double anorm, double* rcond );
-
-lapack_int LAPACKE_spbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_dpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab, lapack_int ldab,
- double* s, double* scond, double* amax );
-lapack_int LAPACKE_cpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_zpbequ( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-
-lapack_int LAPACKE_spbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb, lapack_int ldafb,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb, lapack_int ldafb,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpbrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* afb, lapack_int ldafb,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_spbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb );
-lapack_int LAPACKE_dpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb );
-lapack_int LAPACKE_cpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_float* bb,
- lapack_int ldbb );
-lapack_int LAPACKE_zpbstf( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_double* bb,
- lapack_int ldbb );
-
-lapack_int LAPACKE_spbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbsv( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* afb, lapack_int ldafb,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* afb, lapack_int ldafb,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* afb, lapack_int ldafb,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpbsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* afb, lapack_int ldafb,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr );
-
-lapack_int LAPACKE_spbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab );
-lapack_int LAPACKE_dpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab );
-lapack_int LAPACKE_cpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab );
-lapack_int LAPACKE_zpbtrf( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab );
-
-lapack_int LAPACKE_spbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbtrs( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spftrf( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftrf( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftri( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftri( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftri( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftri( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpftrs( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spocon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond );
-lapack_int LAPACKE_dpocon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond );
-lapack_int LAPACKE_cpocon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond );
-lapack_int LAPACKE_zpocon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond );
-
-lapack_int LAPACKE_spoequ( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequ( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequ( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequ( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_spoequb( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequb( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequb( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequb( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_sporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_cporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_zporfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr );
-
-lapack_int LAPACKE_sporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const float* s, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const double* s, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zporfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const double* s, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_sposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- lapack_int* iter );
-lapack_int LAPACKE_zcposv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_int* iter );
-
-lapack_int LAPACKE_sposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda, float* af,
- lapack_int ldaf, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_dposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* af, lapack_int ldaf, char* equed, double* s,
- double* b, lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-lapack_int LAPACKE_cposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zposvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_sposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_dposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-lapack_int LAPACKE_cposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zposvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_spotrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dpotrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_cpotrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dpotri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda );
-lapack_int LAPACKE_cpotri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zpotrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sppcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond );
-lapack_int LAPACKE_dppcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond );
-lapack_int LAPACKE_cppcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float anorm,
- float* rcond );
-lapack_int LAPACKE_zppcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sppequ( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dppequ( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cppequ( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_zppequ( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double* s,
- double* scond, double* amax );
-
-lapack_int LAPACKE_spprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_cpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zpprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zppsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* afp, char* equed,
- float* s, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* afp,
- char* equed, double* s, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* afp, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zppsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* afp, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_spptrf( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptrf( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptri( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptri( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spstrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- float tol );
-lapack_int LAPACKE_dpstrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* piv, lapack_int* rank,
- double tol );
-lapack_int LAPACKE_cpstrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, float tol );
-lapack_int LAPACKE_zpstrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, double tol );
-
-lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond );
-lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond );
-lapack_int LAPACKE_cptcon( lapack_int n, const float* d,
- const lapack_complex_float* e, float anorm,
- float* rcond );
-lapack_int LAPACKE_zptcon( lapack_int n, const double* d,
- const lapack_complex_double* e, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_spteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dpteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_cpteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zpteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_sptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dptrfs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, const double* df,
- const double* ef, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* ferr,
- double* berr );
-lapack_int LAPACKE_cptrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zptrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, const double* df,
- const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb );
-lapack_int LAPACKE_dptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b, lapack_int ldb );
-lapack_int LAPACKE_cptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zptsv( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d, const double* e,
- double* df, double* ef, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-lapack_int LAPACKE_cptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zptsvx( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, double* df,
- lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_spttrf( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dpttrf( lapack_int n, double* d, double* e );
-lapack_int LAPACKE_cpttrf( lapack_int n, float* d, lapack_complex_float* e );
-lapack_int LAPACKE_zpttrf( lapack_int n, double* d, lapack_complex_double* e );
-
-lapack_int LAPACKE_spttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpttrs( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpttrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpttrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbev( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab, double* w,
- double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbevd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, const float* bb, lapack_int ldbb,
- float* x, lapack_int ldx );
-lapack_int LAPACKE_dsbgst( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, const double* bb, lapack_int ldbb,
- double* x, lapack_int ldx );
-
-lapack_int LAPACKE_ssbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb, float* w,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbgv( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, float* ab,
- lapack_int ldab, float* bb, lapack_int ldbb,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dsbgvd( int matrix_order, char jobz, char uplo, lapack_int n,
- lapack_int ka, lapack_int kb, double* ab,
- lapack_int ldab, double* bb, lapack_int ldbb,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_ssbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* q, lapack_int ldq, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbgvx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* q, lapack_int ldq,
- double vl, double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab, float* d,
- float* e, float* q, lapack_int ldq );
-lapack_int LAPACKE_dsbtrd( int matrix_order, char vect, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq );
-
-lapack_int LAPACKE_ssfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, float alpha,
- const float* a, lapack_int lda, float beta,
- float* c );
-lapack_int LAPACKE_dsfrk( int matrix_order, char transr, char uplo, char trans,
- lapack_int n, lapack_int k, double alpha,
- const double* a, lapack_int lda, double beta,
- double* c );
-
-lapack_int LAPACKE_sspcon( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv, float anorm,
- float* rcond );
-lapack_int LAPACKE_dspcon( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond );
-lapack_int LAPACKE_cspcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zspcon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_sspev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* ap, float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* ap, double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* ap, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dspevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* ap, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_sspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp );
-lapack_int LAPACKE_dspgst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp );
-
-lapack_int LAPACKE_sspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspgv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz );
-lapack_int LAPACKE_dspgvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m, float* w,
- float* z, lapack_int ldz, lapack_int* ifail );
-lapack_int LAPACKE_dspgvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, const float* afp,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dsprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, const double* afp,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_csprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zsprfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_sspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zspsv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* afp,
- lapack_int* ipiv, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* afp,
- lapack_int* ipiv, const double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* ferr, double* berr );
-lapack_int LAPACKE_cspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zspsvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_ssptrd( int matrix_order, char uplo, lapack_int n, float* ap,
- float* d, float* e, float* tau );
-lapack_int LAPACKE_dsptrd( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssptrf( int matrix_order, char uplo, lapack_int n, float* ap,
- lapack_int* ipiv );
-lapack_int LAPACKE_dsptrf( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv );
-lapack_int LAPACKE_csptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zsptrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptri( int matrix_order, char uplo, lapack_int n, float* ap,
- const lapack_int* ipiv );
-lapack_int LAPACKE_dsptri( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_csptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, const lapack_int* ipiv );
-lapack_int LAPACKE_zsptri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, const lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zsptrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- const float* d, const float* e, lapack_int* m,
- lapack_int* nsplit, float* w, lapack_int* iblock,
- lapack_int* isplit );
-lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit );
-
-lapack_int LAPACKE_sstedc( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstedc( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_cstedc( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zstedc( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_sstegr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dstegr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-lapack_int LAPACKE_cstegr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* isuppz );
-lapack_int LAPACKE_zstegr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz );
-
-lapack_int LAPACKE_sstein( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock, const lapack_int* isplit,
- float* z, lapack_int ldz, lapack_int* ifailv );
-lapack_int LAPACKE_dstein( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock, const lapack_int* isplit,
- double* z, lapack_int ldz, lapack_int* ifailv );
-lapack_int LAPACKE_cstein( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock, const lapack_int* isplit,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* ifailv );
-lapack_int LAPACKE_zstein( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock, const lapack_int* isplit,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* ifailv );
-
-lapack_int LAPACKE_sstemr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* m,
- float* w, float* z, lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac );
-lapack_int LAPACKE_dstemr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-lapack_int LAPACKE_cstemr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, lapack_int* m,
- float* w, lapack_complex_float* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-lapack_int LAPACKE_zstemr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac );
-
-lapack_int LAPACKE_ssteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dsteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz );
-lapack_int LAPACKE_csteqr( int matrix_order, char compz, lapack_int n, float* d,
- float* e, lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zsteqr( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz );
-
-lapack_int LAPACKE_ssterf( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dsterf( lapack_int n, double* d, double* e );
-
-lapack_int LAPACKE_sstev( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstev( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sstevd( int matrix_order, char jobz, lapack_int n, float* d,
- float* e, float* z, lapack_int ldz );
-lapack_int LAPACKE_dstevd( int matrix_order, char jobz, lapack_int n, double* d,
- double* e, double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sstevr( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dstevr( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-
-lapack_int LAPACKE_sstevx( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dstevx( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssycon( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_dsycon( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-lapack_int LAPACKE_csycon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm, float* rcond );
-lapack_int LAPACKE_zsycon( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond );
-
-lapack_int LAPACKE_ssyequb( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_dsyequb( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax );
-lapack_int LAPACKE_csyequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zsyequb( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_ssyev( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_dsyev( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_ssyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- float* a, lapack_int lda, float* w );
-lapack_int LAPACKE_dsyevd( int matrix_order, char jobz, char uplo, lapack_int n,
- double* a, lapack_int lda, double* w );
-
-lapack_int LAPACKE_ssyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* isuppz );
-lapack_int LAPACKE_dsyevr( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz );
-
-lapack_int LAPACKE_ssyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, float* a, lapack_int lda, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsyevx( int matrix_order, char jobz, char range, char uplo,
- lapack_int n, double* a, lapack_int lda, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb );
-lapack_int LAPACKE_dsygst( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w );
-lapack_int LAPACKE_dsygv( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w );
-
-lapack_int LAPACKE_ssygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* w );
-lapack_int LAPACKE_dsygvd( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* w );
-
-lapack_int LAPACKE_ssygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float vl,
- float vu, lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z, lapack_int ldz,
- lapack_int* ifail );
-lapack_int LAPACKE_dsygvx( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* ifail );
-
-lapack_int LAPACKE_ssyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dsyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_csyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_zsyrfs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_ssyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dsyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_csyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params );
-lapack_int LAPACKE_zsyrfsx( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af, lapack_int ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params );
-
-lapack_int LAPACKE_ssysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsysv( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* af, lapack_int ldaf, lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr );
-lapack_int LAPACKE_dsysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- double* af, lapack_int ldaf, lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr );
-lapack_int LAPACKE_csysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr );
-lapack_int LAPACKE_zsysvx( int matrix_order, char fact, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* af,
- lapack_int ldaf, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr );
-
-lapack_int LAPACKE_ssysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_dsysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-lapack_int LAPACKE_csysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params );
-lapack_int LAPACKE_zsysvxx( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params );
-
-lapack_int LAPACKE_ssytrd( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, float* d, float* e, float* tau );
-lapack_int LAPACKE_dsytrd( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssytrf( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dsytrf( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_csytrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zsytrf( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_ssytri( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsytri( int matrix_order, char uplo, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_csytri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsytri( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-
-lapack_int LAPACKE_ssytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_dsytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const float* ab,
- lapack_int ldab, float* rcond );
-lapack_int LAPACKE_dtbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd, const double* ab,
- lapack_int ldab, double* rcond );
-lapack_int LAPACKE_ctbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_float* ab, lapack_int ldab,
- float* rcond );
-lapack_int LAPACKE_ztbcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, lapack_int kd,
- const lapack_complex_double* ab, lapack_int ldab,
- double* rcond );
-
-lapack_int LAPACKE_stbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_dtbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr );
-lapack_int LAPACKE_ctbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztbrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_stbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const float* ab, lapack_int ldab, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztbtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- float alpha, const float* a, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- double alpha, const double* a, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztfsm( int matrix_order, char transr, char side, char uplo,
- char trans, char diag, lapack_int m, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, float* a );
-lapack_int LAPACKE_dtftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, double* a );
-lapack_int LAPACKE_ctftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_ztftri( int matrix_order, char transr, char uplo, char diag,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_stfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap );
-lapack_int LAPACKE_dtfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap );
-lapack_int LAPACKE_ctfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztfttp( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dtfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda );
-lapack_int LAPACKE_ctfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztfttr( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_stgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_dtgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds, const double* p,
- lapack_int ldp, double* vl, lapack_int ldvl,
- double* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_ctgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* s, lapack_int lds,
- const lapack_complex_float* p, lapack_int ldp,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztgevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* s, lapack_int lds,
- const lapack_complex_double* p, lapack_int ldp,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-
-lapack_int LAPACKE_stgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_dtgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_ctgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztgexc( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_stgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- lapack_int* m, float* pl, float* pr, float* dif );
-lapack_int LAPACKE_dtgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* q, lapack_int ldq, double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr, double* dif );
-lapack_int LAPACKE_ctgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* z,
- lapack_int ldz, lapack_int* m, float* pl, float* pr,
- float* dif );
-lapack_int LAPACKE_ztgsen( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr, double* dif );
-
-lapack_int LAPACKE_stgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u, lapack_int ldu,
- float* v, lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_dtgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double tola, double tolb, double* alpha,
- double* beta, double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_ctgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float tola, float tolb, float* alpha,
- float* beta, lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int* ncycle );
-lapack_int LAPACKE_ztgsja( int matrix_order, char jobu, char jobv, char jobq,
- lapack_int m, lapack_int p, lapack_int n,
- lapack_int k, lapack_int l, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double tola, double tolb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* ncycle );
-
-lapack_int LAPACKE_stgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl, lapack_int ldvl,
- const float* vr, lapack_int ldvr, float* s,
- float* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_dtgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ctgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* dif, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztgsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* vl, lapack_int ldvl,
- const lapack_complex_double* vr, lapack_int ldvr,
- double* s, double* dif, lapack_int mm,
- lapack_int* m );
-
-lapack_int LAPACKE_stgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale, float* dif );
-lapack_int LAPACKE_dtgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif );
-lapack_int LAPACKE_ctgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- const lapack_complex_float* d, lapack_int ldd,
- const lapack_complex_float* e, lapack_int lde,
- lapack_complex_float* f, lapack_int ldf,
- float* scale, float* dif );
-lapack_int LAPACKE_ztgsyl( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- const lapack_complex_double* d, lapack_int ldd,
- const lapack_complex_double* e, lapack_int lde,
- lapack_complex_double* f, lapack_int ldf,
- double* scale, double* dif );
-
-lapack_int LAPACKE_stpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* ap, float* rcond );
-lapack_int LAPACKE_dtpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* ap, double* rcond );
-lapack_int LAPACKE_ctpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_float* ap,
- float* rcond );
-lapack_int LAPACKE_ztpcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_double* ap,
- double* rcond );
-
-lapack_int LAPACKE_stprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- const float* b, lapack_int ldb, const float* x,
- lapack_int ldx, float* ferr, float* berr );
-lapack_int LAPACKE_dtprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- const double* b, lapack_int ldb, const double* x,
- lapack_int ldx, double* ferr, double* berr );
-lapack_int LAPACKE_ctprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztprfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_stptri( int matrix_order, char uplo, char diag, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dtptri( int matrix_order, char uplo, char diag, lapack_int n,
- double* ap );
-lapack_int LAPACKE_ctptri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztptri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dtptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_ctptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztptrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf );
-lapack_int LAPACKE_dtpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf );
-lapack_int LAPACKE_ctpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* ap,
- lapack_complex_float* arf );
-lapack_int LAPACKE_ztpttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* ap,
- lapack_complex_double* arf );
-
-lapack_int LAPACKE_stpttr( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda );
-lapack_int LAPACKE_dtpttr( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda );
-lapack_int LAPACKE_ctpttr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztpttr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const float* a, lapack_int lda,
- float* rcond );
-lapack_int LAPACKE_dtrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const double* a, lapack_int lda,
- double* rcond );
-lapack_int LAPACKE_ctrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* rcond );
-lapack_int LAPACKE_ztrcon( int matrix_order, char norm, char uplo, char diag,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* rcond );
-
-lapack_int LAPACKE_strevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n, const float* t,
- lapack_int ldt, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_dtrevc( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ctrevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztrevc( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m );
-
-lapack_int LAPACKE_strexc( int matrix_order, char compq, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_dtrexc( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- lapack_int* ifst, lapack_int* ilst );
-lapack_int LAPACKE_ctrexc( int matrix_order, char compq, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztrexc( int matrix_order, char compq, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_strrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr );
-lapack_int LAPACKE_dtrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr );
-lapack_int LAPACKE_ctrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr );
-lapack_int LAPACKE_ztrrfs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr );
-
-lapack_int LAPACKE_strsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n, float* t,
- lapack_int ldt, float* q, lapack_int ldq, float* wr,
- float* wi, lapack_int* m, float* s, float* sep );
-lapack_int LAPACKE_dtrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q, lapack_int ldq,
- double* wr, double* wi, lapack_int* m, double* s,
- double* sep );
-lapack_int LAPACKE_ctrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* w, lapack_int* m, float* s,
- float* sep );
-lapack_int LAPACKE_ztrsen( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* w, lapack_int* m, double* s,
- double* sep );
-
-lapack_int LAPACKE_strsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_dtrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, const double* vl,
- lapack_int ldvl, const double* vr, lapack_int ldvr,
- double* s, double* sep, lapack_int mm,
- lapack_int* m );
-lapack_int LAPACKE_ctrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* t, lapack_int ldt,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm, lapack_int* m );
-lapack_int LAPACKE_ztrsna( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* t, lapack_int ldt,
- const lapack_complex_double* vl, lapack_int ldvl,
- const lapack_complex_double* vr, lapack_int ldvr,
- double* s, double* sep, lapack_int mm,
- lapack_int* m );
-
-lapack_int LAPACKE_strsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_dtrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, const double* b,
- lapack_int ldb, double* c, lapack_int ldc,
- double* scale );
-lapack_int LAPACKE_ctrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_ztrsyl( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- double* scale );
-
-lapack_int LAPACKE_strtri( int matrix_order, char uplo, char diag, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dtrtri( int matrix_order, char uplo, char diag, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_ctrtri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztrtri( int matrix_order, char uplo, char diag, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztrtrs( int matrix_order, char uplo, char trans, char diag,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_strttf( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf );
-lapack_int LAPACKE_dtrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf );
-lapack_int LAPACKE_ctrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* arf );
-lapack_int LAPACKE_ztrttf( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* arf );
-
-lapack_int LAPACKE_strttp( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap );
-lapack_int LAPACKE_dtrttp( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap );
-lapack_int LAPACKE_ctrttp( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztrttp( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stzrzf( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau );
-lapack_int LAPACKE_dtzrzf( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau );
-lapack_int LAPACKE_ctzrzf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau );
-lapack_int LAPACKE_ztzrzf( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungbr( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zunghr( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zunglq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungql( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungqr( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau );
-lapack_int LAPACKE_zungrq( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cungtr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau );
-lapack_int LAPACKE_zungtr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau );
-
-lapack_int LAPACKE_cunmbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmbr( int matrix_order, char vect, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmhr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmlq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmql( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmqr( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmrq( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmrz( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cunmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zunmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_cupgtr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* q, lapack_int ldq );
-lapack_int LAPACKE_zupgtr( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* q, lapack_int ldq );
-
-lapack_int LAPACKE_cupmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc );
-lapack_int LAPACKE_zupmtr( int matrix_order, char side, char uplo, char trans,
- lapack_int m, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc );
-
-lapack_int LAPACKE_sbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, float* d, float* e, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* q, lapack_int* iq, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dbdsdc_work( int matrix_order, char uplo, char compq,
- lapack_int n, double* d, double* e, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* q, lapack_int* iq, double* work,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, float* vt, lapack_int ldvt,
- float* u, lapack_int ldu, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, double* vt,
- lapack_int ldvt, double* u, lapack_int ldu,
- double* c, lapack_int ldc, double* work );
-lapack_int LAPACKE_cbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- float* d, float* e, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_zbdsqr_work( int matrix_order, char uplo, lapack_int n,
- lapack_int ncvt, lapack_int nru, lapack_int ncc,
- double* d, double* e, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* c,
- lapack_int ldc, double* work );
-
-lapack_int LAPACKE_sdisna_work( char job, lapack_int m, lapack_int n,
- const float* d, float* sep );
-lapack_int LAPACKE_ddisna_work( char job, lapack_int m, lapack_int n,
- const double* d, double* sep );
-
-lapack_int LAPACKE_sgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, float* ab, lapack_int ldab,
- float* d, float* e, float* q, lapack_int ldq,
- float* pt, lapack_int ldpt, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, double* ab, lapack_int ldab,
- double* d, double* e, double* q, lapack_int ldq,
- double* pt, lapack_int ldpt, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_cgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_float* ab,
- lapack_int ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* pt, lapack_int ldpt,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgbbrd_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int ncc, lapack_int kl,
- lapack_int ku, lapack_complex_double* ab,
- lapack_int ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* pt, lapack_int ldpt,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbcon_work( int matrix_order, char norm, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab, lapack_int ldab,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgbequ_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_dgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-lapack_int LAPACKE_cgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_float* ab,
- lapack_int ldab, float* r, float* c,
- float* rowcnd, float* colcnd, float* amax );
-lapack_int LAPACKE_zgbequb_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- const lapack_complex_double* ab,
- lapack_int ldab, double* r, double* c,
- double* rowcnd, double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const float* afb, lapack_int ldafb,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgbrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs,
- const lapack_complex_float* ab,
- lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbrfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, float* ab,
- lapack_int ldab, lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs, double* ab,
- lapack_int ldab, lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbsv_work( int matrix_order, lapack_int n, lapack_int kl,
- lapack_int ku, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- float* r, float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv, char* equed,
- double* r, double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, float* ab, lapack_int ldab,
- float* afb, lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, double* ab, lapack_int ldab,
- double* afb, lapack_int ldafb,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* afb,
- lapack_int ldafb, lapack_int* ipiv,
- char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgbsvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int kl, lapack_int ku,
- lapack_int nrhs, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* afb,
- lapack_int ldafb, lapack_int* ipiv,
- char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, float* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_dgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, double* ab,
- lapack_int ldab, lapack_int* ipiv );
-lapack_int LAPACKE_cgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgbtrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const float* ab, lapack_int ldab,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgbtrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int kl, lapack_int ku, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* scale, lapack_int m, float* v,
- lapack_int ldv );
-lapack_int LAPACKE_dgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* scale, lapack_int m, double* v,
- lapack_int ldv );
-lapack_int LAPACKE_cgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* scale, lapack_int m,
- lapack_complex_float* v, lapack_int ldv );
-lapack_int LAPACKE_zgebak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* scale, lapack_int m,
- lapack_complex_double* v, lapack_int ldv );
-
-lapack_int LAPACKE_sgebal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, float* scale );
-lapack_int LAPACKE_dgebal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, lapack_int* ilo,
- lapack_int* ihi, double* scale );
-lapack_int LAPACKE_cgebal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi,
- float* scale );
-lapack_int LAPACKE_zgebal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ilo, lapack_int* ihi,
- double* scale );
-
-lapack_int LAPACKE_sgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tauq, float* taup, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tauq, double* taup, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* d, float* e, lapack_complex_float* tauq,
- lapack_complex_float* taup,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgebrd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* d, double* e,
- lapack_complex_double* tauq,
- lapack_complex_double* taup,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgecon_work( int matrix_order, char norm, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgecon_work( int matrix_order, char norm, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgecon_work( int matrix_order, char norm, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgecon_work( int matrix_order, char norm, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_dgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgeequ_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, float* r,
- float* c, float* rowcnd, float* colcnd,
- float* amax );
-lapack_int LAPACKE_dgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* r,
- double* c, double* rowcnd, double* colcnd,
- double* amax );
-lapack_int LAPACKE_cgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* r, float* c, float* rowcnd,
- float* colcnd, float* amax );
-lapack_int LAPACKE_zgeequb_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* r, double* c, double* rowcnd,
- double* colcnd, double* amax );
-
-lapack_int LAPACKE_sgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, lapack_int n, float* a,
- lapack_int lda, lapack_int* sdim, float* wr,
- float* wi, float* vs, lapack_int ldvs,
- float* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, lapack_int n, double* a,
- lapack_int lda, lapack_int* sdim, double* wr,
- double* wi, double* vs, lapack_int ldvs,
- double* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgees_work( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_S_SELECT2 select, char sense,
- lapack_int n, float* a, lapack_int lda,
- lapack_int* sdim, float* wr, float* wi,
- float* vs, lapack_int ldvs, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_D_SELECT2 select, char sense,
- lapack_int n, double* a, lapack_int lda,
- lapack_int* sdim, double* wr, double* wi,
- double* vs, lapack_int ldvs, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_C_SELECT1 select, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_int* sdim,
- lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int ldvs,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgeesx_work( int matrix_order, char jobvs, char sort,
- LAPACK_Z_SELECT1 select, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_int* sdim,
- lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int ldvs,
- double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda,
- float* wr, float* wi, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* wr, double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* wr, float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* wr, double* wi,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* scale, double* abnrm,
- double* rconde, double* rcondv, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- float* abnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- double* abnrm, double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- double* tau, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgehrd_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgejsv_work( int matrix_order, char joba, char jobu,
- char jobv, char jobr, char jobt, char jobp,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* sva, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work );
-lapack_int LAPACKE_dgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work );
-lapack_int LAPACKE_cgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zgelq2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgelqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgels_work( int matrix_order, char trans, lapack_int m,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork );
-lapack_int LAPACKE_zgelsd_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* s, float rcond,
- lapack_int* rank, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* s,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* s, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgelss_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double* s, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* jpvt,
- float rcond, lapack_int* rank, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* jpvt,
- double rcond, lapack_int* rank, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_cgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* jpvt, float rcond,
- lapack_int* rank, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgelsy_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* jpvt, double rcond,
- lapack_int* rank, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqlf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zgeqp3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* jpvt,
- float* tau, float* work );
-lapack_int LAPACKE_dgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* jpvt,
- double* tau, double* work );
-lapack_int LAPACKE_cgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_float* tau,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgeqpf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* jpvt, lapack_complex_double* tau,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work );
-lapack_int LAPACKE_dgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work );
-lapack_int LAPACKE_cgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zgeqr2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgeqrfp_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgerfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* r, const float* c, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* r, const double* c,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* r, const float* c,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgerfsx_work( int matrix_order, char trans, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* r, const double* c,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgerqf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, float* a, lapack_int lda,
- float* s, float* u, lapack_int ldu, float* vt,
- lapack_int ldvt, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, double* a, lapack_int lda,
- double* s, double* u, lapack_int ldu,
- double* vt, lapack_int ldvt, double* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_cgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* s,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* vt, lapack_int ldvt,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork );
-lapack_int LAPACKE_zgesdd_work( int matrix_order, char jobz, lapack_int m,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* s,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* vt, lapack_int ldvt,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork );
-
-lapack_int LAPACKE_sgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter );
-lapack_int LAPACKE_zcgesv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- lapack_complex_float* swork, double* rwork,
- lapack_int* iter );
-
-lapack_int LAPACKE_sgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* s, float* u,
- lapack_int ldu, float* vt, lapack_int ldvt,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n, double* a,
- lapack_int lda, double* s, double* u,
- lapack_int ldu, double* vt, lapack_int ldvt,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* s, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* vt,
- lapack_int ldvt, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zgesvd_work( int matrix_order, char jobu, char jobvt,
- lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* s, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* vt,
- lapack_int ldvt, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_sgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n, float* a,
- lapack_int lda, float* sva, lapack_int mv,
- float* v, lapack_int ldv, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dgesvj_work( int matrix_order, char joba, char jobu,
- char jobv, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* sva,
- lapack_int mv, double* v, lapack_int ldv,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zgesvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, double* b, lapack_int ldb,
- double* x, lapack_int ldx, double* rcond,
- double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgesvxx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetf2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_dgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv );
-lapack_int LAPACKE_cgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv );
-lapack_int LAPACKE_zgetrf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv );
-
-lapack_int LAPACKE_sgetri_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dgetri_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cgetri_work( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgetri_work( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgetrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* lscale, const float* rscale,
- lapack_int m, float* v, lapack_int ldv );
-lapack_int LAPACKE_dggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* lscale, const double* rscale,
- lapack_int m, double* v, lapack_int ldv );
-lapack_int LAPACKE_cggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const float* lscale, const float* rscale,
- lapack_int m, lapack_complex_float* v,
- lapack_int ldv );
-lapack_int LAPACKE_zggbak_work( int matrix_order, char job, char side,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- const double* lscale, const double* rscale,
- lapack_int m, lapack_complex_double* v,
- lapack_int ldv );
-
-lapack_int LAPACKE_sggbal_work( int matrix_order, char job, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* work );
-lapack_int LAPACKE_dggbal_work( int matrix_order, char job, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* work );
-lapack_int LAPACKE_cggbal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* work );
-lapack_int LAPACKE_zggbal_work( int matrix_order, char job, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* work );
-
-lapack_int LAPACKE_sgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, lapack_int* sdim, float* alphar,
- float* alphai, float* beta, float* vsl,
- lapack_int ldvsl, float* vsr, lapack_int ldvsr,
- float* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, lapack_int* sdim, double* alphar,
- double* alphai, double* beta, double* vsl,
- lapack_int ldvsl, double* vsr, lapack_int ldvsr,
- double* work, lapack_int lwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_logical* bwork );
-lapack_int LAPACKE_zgges_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_int* sdim, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_S_SELECT3 selctg, char sense,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, lapack_int* sdim,
- float* alphar, float* alphai, float* beta,
- float* vsl, lapack_int ldvsl, float* vsr,
- lapack_int ldvsr, float* rconde, float* rcondv,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_dggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_D_SELECT3 selctg, char sense,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, lapack_int* sdim,
- double* alphar, double* alphai, double* beta,
- double* vsl, lapack_int ldvsl, double* vsr,
- lapack_int ldvsr, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_cggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_C_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int ldvsl,
- lapack_complex_float* vsr, lapack_int ldvsr,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork,
- lapack_int liwork, lapack_logical* bwork );
-lapack_int LAPACKE_zggesx_work( int matrix_order, char jobvsl, char jobvsr,
- char sort, LAPACK_Z_SELECT2 selctg, char sense,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_int* sdim,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int ldvsl,
- lapack_complex_double* vsr, lapack_int ldvsr,
- double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork,
- lapack_int liwork, lapack_logical* bwork );
-
-lapack_int LAPACKE_sggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* alphar,
- double* alphai, double* beta, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_cggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zggev_work( int matrix_order, char jobvl, char jobvr,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_sggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* alphar, float* alphai, float* beta,
- float* vl, lapack_int ldvl, float* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale,
- float* abnrm, float* bbnrm, float* rconde,
- float* rcondv, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork );
-lapack_int LAPACKE_dggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* alphar, double* alphai, double* beta,
- double* vl, lapack_int ldvl, double* vr,
- lapack_int ldvr, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* abnrm, double* bbnrm, double* rconde,
- double* rcondv, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_logical* bwork );
-lapack_int LAPACKE_cggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm,
- float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int* iwork,
- lapack_logical* bwork );
-lapack_int LAPACKE_zggevx_work( int matrix_order, char balanc, char jobvl,
- char jobvr, char sense, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int* iwork,
- lapack_logical* bwork );
-
-lapack_int LAPACKE_sggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* d, float* x,
- float* y, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* d, double* x,
- double* y, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* d,
- lapack_complex_float* x,
- lapack_complex_float* y,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggglm_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* d,
- lapack_complex_double* x,
- lapack_complex_double* y,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* q, lapack_int ldq,
- float* z, lapack_int ldz );
-lapack_int LAPACKE_dgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* q, lapack_int ldq,
- double* z, lapack_int ldz );
-lapack_int LAPACKE_cgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz );
-lapack_int LAPACKE_zgghrd_work( int matrix_order, char compq, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz );
-
-lapack_int LAPACKE_sgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, float* a, lapack_int lda,
- float* b, lapack_int ldb, float* c, float* d,
- float* x, float* work, lapack_int lwork );
-lapack_int LAPACKE_dgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* c, double* d,
- double* x, double* work, lapack_int lwork );
-lapack_int LAPACKE_cgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* c,
- lapack_complex_float* d,
- lapack_complex_float* x,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zgglse_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* c,
- lapack_complex_double* d,
- lapack_complex_double* x,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggqrf_work( int matrix_order, lapack_int n, lapack_int m,
- lapack_int p, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* taua, float* b, lapack_int ldb,
- float* taub, float* work, lapack_int lwork );
-lapack_int LAPACKE_dggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* taua, double* b, lapack_int ldb,
- double* taub, double* work, lapack_int lwork );
-lapack_int LAPACKE_cggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* taua,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zggrqf_work( int matrix_order, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* taua,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alpha, float* beta,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alpha, double* beta,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* alpha, float* beta,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork );
-lapack_int LAPACKE_zggsvd_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int n,
- lapack_int p, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* alpha, double* beta,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_sggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, float* a, lapack_int lda,
- float* b, lapack_int ldb, float tola,
- float tolb, lapack_int* k, lapack_int* l,
- float* u, lapack_int ldu, float* v,
- lapack_int ldv, float* q, lapack_int ldq,
- lapack_int* iwork, float* tau, float* work );
-lapack_int LAPACKE_dggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, double* a, lapack_int lda,
- double* b, lapack_int ldb, double tola,
- double tolb, lapack_int* k, lapack_int* l,
- double* u, lapack_int ldu, double* v,
- lapack_int ldv, double* q, lapack_int ldq,
- lapack_int* iwork, double* tau, double* work );
-lapack_int LAPACKE_cggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float tola, float tolb,
- lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int ldu,
- lapack_complex_float* v, lapack_int ldv,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int* iwork, float* rwork,
- lapack_complex_float* tau,
- lapack_complex_float* work );
-lapack_int LAPACKE_zggsvp_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, double tola, double tolb,
- lapack_int* k, lapack_int* l,
- lapack_complex_double* u, lapack_int ldu,
- lapack_complex_double* v, lapack_int ldv,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int* iwork, double* rwork,
- lapack_complex_double* tau,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_sgtcon_work( char norm, lapack_int n, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgtcon_work( char norm, lapack_int n, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgtcon_work( char norm, lapack_int n,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zgtcon_work( char norm, lapack_int n,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* dlf, const float* df,
- const float* duf, const float* du2,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* dlf, const double* df,
- const double* duf, const double* du2,
- const lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgtrfs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* dl, float* d, float* du, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* dl, double* d, double* du, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_float* dl,
- lapack_complex_float* d,
- lapack_complex_float* du,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zgtsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- lapack_complex_double* dl,
- lapack_complex_double* d,
- lapack_complex_double* du,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const float* dl,
- const float* d, const float* du, float* dlf,
- float* df, float* duf, float* du2,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs, const double* dl,
- const double* d, const double* du, double* dlf,
- double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- lapack_complex_float* dlf,
- lapack_complex_float* df,
- lapack_complex_float* duf,
- lapack_complex_float* du2, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zgtsvx_work( int matrix_order, char fact, char trans,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- lapack_complex_double* dlf,
- lapack_complex_double* df,
- lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sgttrf_work( lapack_int n, float* dl, float* d, float* du,
- float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_dgttrf_work( lapack_int n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv );
-lapack_int LAPACKE_cgttrf_work( lapack_int n, lapack_complex_float* dl,
- lapack_complex_float* d,
- lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv );
-lapack_int LAPACKE_zgttrf_work( lapack_int n, lapack_complex_double* dl,
- lapack_complex_double* d,
- lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv );
-
-lapack_int LAPACKE_sgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const float* dl,
- const float* d, const float* du,
- const float* du2, const lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const double* dl,
- const double* d, const double* du,
- const double* du2, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zgttrs_work( int matrix_order, char trans, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* q, lapack_int ldq,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_zhbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* q, lapack_int ldq,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_chbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* bb, lapack_int ldbb,
- lapack_complex_float* x, lapack_int ldx,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- const lapack_complex_double* bb,
- lapack_int ldbb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* bb, lapack_int ldbb,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* bb, lapack_int ldbb,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* bb,
- lapack_int ldbb, lapack_complex_float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* bb,
- lapack_int ldbb, lapack_complex_double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_float* ab, lapack_int ldab,
- float* d, float* e, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* work );
-lapack_int LAPACKE_zhbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd,
- lapack_complex_double* ab, lapack_int ldab,
- double* d, double* e, lapack_complex_double* q,
- lapack_int ldq, lapack_complex_double* work );
-
-lapack_int LAPACKE_checon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zhecon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_cheequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax,
- lapack_complex_float* work );
-lapack_int LAPACKE_zheequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_cheev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zheev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* w,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_cheevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zheevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, double* w,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_cheevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_int* isuppz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zheevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_int* isuppz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_cheevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zheevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chegst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhegst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chegv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb, float* w,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zhegv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* w, lapack_complex_double* work,
- lapack_int lwork, double* rwork );
-
-lapack_int LAPACKE_chegvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float* w, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhegvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double* w, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chegvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhegvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_cherfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zherfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_cherfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zherfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chesv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhesv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_chesvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zhesvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_chesvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zhesvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chetrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- float* d, float* e, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhetrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- double* d, double* e,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_chetrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* work,
- lapack_int lwork );
-lapack_int LAPACKE_zhetrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_chetri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zhetri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_chetrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_chfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- float alpha, const lapack_complex_float* a,
- lapack_int lda, float beta,
- lapack_complex_float* c );
-lapack_int LAPACKE_zhfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- double alpha, const lapack_complex_double* a,
- lapack_int lda, double beta,
- lapack_complex_double* c );
-
-lapack_int LAPACKE_shgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* h, lapack_int ldh,
- float* t, lapack_int ldt, float* alphar,
- float* alphai, float* beta, float* q,
- lapack_int ldq, float* z, lapack_int ldz,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dhgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* h, lapack_int ldh,
- double* t, lapack_int ldt, double* alphar,
- double* alphai, double* beta, double* q,
- lapack_int ldq, double* z, lapack_int ldz,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_chgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* h,
- lapack_int ldh, lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork );
-lapack_int LAPACKE_zhgeqz_work( int matrix_order, char job, char compq,
- char compz, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* h,
- lapack_int ldh, lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_chpcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zhpcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_chpev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* ap, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* ap,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_chpevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_float* ap,
- float* w, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zhpevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_complex_double* ap,
- double* w, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_chpevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_float* ap, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhpevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n,
- lapack_complex_double* ap, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chpgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_float* ap,
- const lapack_complex_float* bp );
-lapack_int LAPACKE_zhpgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, lapack_complex_double* ap,
- const lapack_complex_double* bp );
-
-lapack_int LAPACKE_chpgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chpgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_zhpgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_chpgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_float* ap,
- lapack_complex_float* bp, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_zhpgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n,
- lapack_complex_double* ap,
- lapack_complex_double* bp, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_chprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chpsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhpsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_chpsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zhpsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_chptrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, float* d, float* e,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zhptrd_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, double* d, double* e,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_chptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zhptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_chptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zhptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_chptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zhptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_shsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const float* h, lapack_int ldh,
- float* wr, const float* wi, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_dhsein_work( int matrix_order, char job, char eigsrc,
- char initv, lapack_logical* select,
- lapack_int n, const double* h, lapack_int ldh,
- double* wr, const double* wi, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_chsein_work( int matrix_order, char job, char eigsrc,
- char initv, const lapack_logical* select,
- lapack_int n, const lapack_complex_float* h,
- lapack_int ldh, lapack_complex_float* w,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork,
- lapack_int* ifaill, lapack_int* ifailr );
-lapack_int LAPACKE_zhsein_work( int matrix_order, char job, char eigsrc,
- char initv, const lapack_logical* select,
- lapack_int n, const lapack_complex_double* h,
- lapack_int ldh, lapack_complex_double* w,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int* ifaill, lapack_int* ifailr );
-
-lapack_int LAPACKE_shseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- float* h, lapack_int ldh, float* wr, float* wi,
- float* z, lapack_int ldz, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dhseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- double* h, lapack_int ldh, double* wr,
- double* wi, double* z, lapack_int ldz,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_chseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_float* h, lapack_int ldh,
- lapack_complex_float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zhseqr_work( int matrix_order, char job, char compz,
- lapack_int n, lapack_int ilo, lapack_int ihi,
- lapack_complex_double* h, lapack_int ldh,
- lapack_complex_double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_clacgv_work( lapack_int n, lapack_complex_float* x,
- lapack_int incx );
-lapack_int LAPACKE_zlacgv_work( lapack_int n, lapack_complex_double* x,
- lapack_int incx );
-
-lapack_int LAPACKE_slacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dlacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_clacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zlacpy_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_zlag2c_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_float* sa, lapack_int ldsa );
-
-lapack_int LAPACKE_slag2d_work( int matrix_order, lapack_int m, lapack_int n,
- const float* sa, lapack_int ldsa, double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_dlag2s_work( int matrix_order, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, float* sa,
- lapack_int ldsa );
-
-lapack_int LAPACKE_clag2z_work( int matrix_order, lapack_int m, lapack_int n,
- const lapack_complex_float* sa, lapack_int ldsa,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- float* a, lapack_int lda, lapack_int* iseed,
- float* work );
-lapack_int LAPACKE_dlagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- double* a, lapack_int lda, lapack_int* iseed,
- double* work );
-lapack_int LAPACKE_clagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const float* d,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* iseed, lapack_complex_float* work );
-lapack_int LAPACKE_zlagge_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int kl, lapack_int ku, const double* d,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_claghe_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlaghe_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed, float* work );
-lapack_int LAPACKE_dlagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed, double* work );
-lapack_int LAPACKE_clagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlagsy_work( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_dlapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_clapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n,
- lapack_complex_float* x, lapack_int ldx,
- lapack_int* k );
-lapack_int LAPACKE_zlapmr_work( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n,
- lapack_complex_double* x, lapack_int ldx,
- lapack_int* k );
-
-lapack_int LAPACKE_slartgp_work( float f, float g, float* cs, float* sn,
- float* r );
-lapack_int LAPACKE_dlartgp_work( double f, double g, double* cs, double* sn,
- double* r );
-
-lapack_int LAPACKE_slartgs_work( float x, float y, float sigma, float* cs,
- float* sn );
-lapack_int LAPACKE_dlartgs_work( double x, double y, double sigma, double* cs,
- double* sn );
-
-float LAPACKE_slapy2_work( float x, float y );
-double LAPACKE_dlapy2_work( double x, double y );
-
-float LAPACKE_slapy3_work( float x, float y, float z );
-double LAPACKE_dlapy3_work( double x, double y, double z );
-
-float LAPACKE_slamch_work( char cmach );
-double LAPACKE_dlamch_work( char cmach );
-
-float LAPACKE_slange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const float* a, lapack_int lda,
- float* work );
-double LAPACKE_dlange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const double* a, lapack_int lda,
- double* work );
-float LAPACKE_clange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlange_work( int matrix_order, char norm, lapack_int m,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_clanhe_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlanhe_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_slansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* work );
-double LAPACKE_dlansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* work );
-float LAPACKE_clansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, float* work );
-double LAPACKE_zlansy_work( int matrix_order, char norm, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, double* work );
-
-float LAPACKE_slantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n, const float* a,
- lapack_int lda, float* work );
-double LAPACKE_dlantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const double* a, lapack_int lda, double* work );
-float LAPACKE_clantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* work );
-double LAPACKE_zlantr_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* work );
-
-lapack_int LAPACKE_slarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* c, lapack_int ldc, float* work,
- lapack_int ldwork );
-lapack_int LAPACKE_dlarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* c, lapack_int ldc, double* work,
- lapack_int ldwork );
-lapack_int LAPACKE_clarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int ldwork );
-lapack_int LAPACKE_zlarfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work,
- lapack_int ldwork );
-
-lapack_int LAPACKE_slarfg_work( lapack_int n, float* alpha, float* x,
- lapack_int incx, float* tau );
-lapack_int LAPACKE_dlarfg_work( lapack_int n, double* alpha, double* x,
- lapack_int incx, double* tau );
-lapack_int LAPACKE_clarfg_work( lapack_int n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* tau );
-lapack_int LAPACKE_zlarfg_work( lapack_int n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* tau );
-
-lapack_int LAPACKE_slarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const float* v,
- lapack_int ldv, const float* tau, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dlarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k, const double* v,
- lapack_int ldv, const double* tau, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_clarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* tau,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zlarft_work( int matrix_order, char direct, char storev,
- lapack_int n, lapack_int k,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* tau,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_slarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const float* v, float tau,
- float* c, lapack_int ldc, float* work );
-lapack_int LAPACKE_dlarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const double* v, double tau,
- double* c, lapack_int ldc, double* work );
-lapack_int LAPACKE_clarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_float* v,
- lapack_complex_float tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work );
-lapack_int LAPACKE_zlarfx_work( int matrix_order, char side, lapack_int m,
- lapack_int n, const lapack_complex_double* v,
- lapack_complex_double tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_slarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, float* x );
-lapack_int LAPACKE_dlarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, double* x );
-lapack_int LAPACKE_clarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, lapack_complex_float* x );
-lapack_int LAPACKE_zlarnv_work( lapack_int idist, lapack_int* iseed,
- lapack_int n, lapack_complex_double* x );
-
-lapack_int LAPACKE_slaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, float alpha, float beta, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dlaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, double alpha, double beta,
- double* a, lapack_int lda );
-lapack_int LAPACKE_claset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- lapack_complex_float beta,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlaset_work( int matrix_order, char uplo, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- lapack_complex_double beta,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_slasrt_work( char id, lapack_int n, float* d );
-lapack_int LAPACKE_dlasrt_work( char id, lapack_int n, double* d );
-
-lapack_int LAPACKE_slaswp_work( int matrix_order, lapack_int n, float* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_dlaswp_work( int matrix_order, lapack_int n, double* a,
- lapack_int lda, lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_claswp_work( int matrix_order, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-lapack_int LAPACKE_zlaswp_work( int matrix_order, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int k1, lapack_int k2,
- const lapack_int* ipiv, lapack_int incx );
-
-lapack_int LAPACKE_slatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- float* d, lapack_int mode, float cond,
- float dmax, lapack_int kl, lapack_int ku,
- char pack, float* a, lapack_int lda,
- float* work );
-lapack_int LAPACKE_dlatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- double* d, lapack_int mode, double cond,
- double dmax, lapack_int kl, lapack_int ku,
- char pack, double* a, lapack_int lda,
- double* work );
-lapack_int LAPACKE_clatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- float* d, lapack_int mode, float cond,
- float dmax, lapack_int kl, lapack_int ku,
- char pack, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* work );
-lapack_int LAPACKE_zlatms_work( int matrix_order, lapack_int m, lapack_int n,
- char dist, lapack_int* iseed, char sym,
- double* d, lapack_int mode, double cond,
- double dmax, lapack_int kl, lapack_int ku,
- char pack, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* work );
-
-lapack_int LAPACKE_slauum_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dlauum_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_clauum_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zlauum_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_sopgtr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const float* tau, float* q,
- lapack_int ldq, float* work );
-lapack_int LAPACKE_dopgtr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const double* tau, double* q,
- lapack_int ldq, double* work );
-
-lapack_int LAPACKE_sopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* ap, const float* tau, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dopmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* ap, const double* tau, double* c,
- lapack_int ldc, double* work );
-
-lapack_int LAPACKE_sorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, float* a,
- lapack_int lda, const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k, double* a,
- lapack_int lda, const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, float* a, lapack_int lda,
- const float* tau, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorgrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, double* a, lapack_int lda,
- const double* tau, double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_sorgtr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dorgtr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const double* tau,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_sormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const float* a, lapack_int lda,
- const float* tau, float* c, lapack_int ldc,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dormtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* tau, double* c, lapack_int ldc,
- double* work, lapack_int lwork );
-
-lapack_int LAPACKE_spbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double anorm, double* rcond,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpbcon_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const float* ab, lapack_int ldab,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_dpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_float* ab,
- lapack_int ldab, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_zpbequ_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, const lapack_complex_double* ab,
- lapack_int ldab, double* s, double* scond,
- double* amax );
-
-lapack_int LAPACKE_spbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* afb,
- lapack_int ldafb, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab,
- const double* afb, lapack_int ldafb,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- const lapack_complex_float* afb,
- lapack_int ldafb, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpbrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab,
- const lapack_complex_double* afb,
- lapack_int ldafb,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, float* bb, lapack_int ldbb );
-lapack_int LAPACKE_dpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, double* bb, lapack_int ldbb );
-lapack_int LAPACKE_cpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_float* bb,
- lapack_int ldbb );
-lapack_int LAPACKE_zpbstf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kb, lapack_complex_double* bb,
- lapack_int ldbb );
-
-lapack_int LAPACKE_spbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- float* ab, lapack_int ldab, float* afb,
- lapack_int ldafb, char* equed, float* s,
- float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- double* ab, lapack_int ldab, double* afb,
- lapack_int ldafb, char* equed, double* s,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_cpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* afb, lapack_int ldafb,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zpbsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int kd, lapack_int nrhs,
- lapack_complex_double* ab, lapack_int ldab,
- lapack_complex_double* afb, lapack_int ldafb,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, float* ab, lapack_int ldab );
-lapack_int LAPACKE_dpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, double* ab, lapack_int ldab );
-lapack_int LAPACKE_cpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_float* ab,
- lapack_int ldab );
-lapack_int LAPACKE_zpbtrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_complex_double* ab,
- lapack_int ldab );
-
-lapack_int LAPACKE_spbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const double* ab, lapack_int ldab, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_float* ab, lapack_int ldab,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpbtrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int kd, lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_spftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftrf_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, float* a );
-lapack_int LAPACKE_dpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, double* a );
-lapack_int LAPACKE_cpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_float* a );
-lapack_int LAPACKE_zpftri_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_complex_double* a );
-
-lapack_int LAPACKE_spftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpftrs_work( int matrix_order, char transr, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spocon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dpocon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cpocon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float anorm, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpocon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double anorm, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spoequ_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequ_work( int matrix_order, lapack_int n, const double* a,
- lapack_int lda, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cpoequ_work( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequ_work( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_spoequb_work( int matrix_order, lapack_int n, const float* a,
- lapack_int lda, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dpoequb_work( int matrix_order, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax );
-lapack_int LAPACKE_cpoequb_work( int matrix_order, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax );
-lapack_int LAPACKE_zpoequb_work( int matrix_order, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax );
-
-lapack_int LAPACKE_sporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zporfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const float* s,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const double* s,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const float* s,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zporfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* work, float* swork,
- lapack_int* iter );
-lapack_int LAPACKE_zcposv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, lapack_complex_double* work,
- lapack_complex_float* swork, double* rwork,
- lapack_int* iter );
-
-lapack_int LAPACKE_sposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zposvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zposvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_spotrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dpotrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_cpotrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda );
-lapack_int LAPACKE_dpotri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda );
-lapack_int LAPACKE_cpotri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zpotri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_spotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_cpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zpotrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sppcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float anorm, float* rcond,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dppcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double anorm, double* rcond,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cppcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float anorm,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zppcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double anorm,
- double* rcond, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_sppequ_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* s, float* scond,
- float* amax );
-lapack_int LAPACKE_dppequ_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* s, double* scond,
- double* amax );
-lapack_int LAPACKE_cppequ_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap, float* s,
- float* scond, float* amax );
-lapack_int LAPACKE_zppequ_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap, double* s,
- double* scond, double* amax );
-
-lapack_int LAPACKE_spprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zpprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zppsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* ap,
- float* afp, char* equed, float* s, float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* ap,
- double* afp, char* equed, double* s, double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* ap,
- lapack_complex_float* afp, char* equed,
- float* s, lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zppsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* ap,
- lapack_complex_double* afp, char* equed,
- double* s, lapack_complex_double* b,
- lapack_int ldb, lapack_complex_double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_spptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap );
-lapack_int LAPACKE_dpptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap );
-lapack_int LAPACKE_cpptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap );
-lapack_int LAPACKE_zpptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_spptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_spstrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, float tol, float* work );
-lapack_int LAPACKE_dpstrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* piv,
- lapack_int* rank, double tol, double* work );
-lapack_int LAPACKE_cpstrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, float tol,
- float* work );
-lapack_int LAPACKE_zpstrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* piv, lapack_int* rank, double tol,
- double* work );
-
-lapack_int LAPACKE_sptcon_work( lapack_int n, const float* d, const float* e,
- float anorm, float* rcond, float* work );
-lapack_int LAPACKE_dptcon_work( lapack_int n, const double* d, const double* e,
- double anorm, double* rcond, double* work );
-lapack_int LAPACKE_cptcon_work( lapack_int n, const float* d,
- const lapack_complex_float* e, float anorm,
- float* rcond, float* work );
-lapack_int LAPACKE_zptcon_work( lapack_int n, const double* d,
- const lapack_complex_double* e, double anorm,
- double* rcond, double* work );
-
-lapack_int LAPACKE_spteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dpteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-lapack_int LAPACKE_cpteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_zpteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_sptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, const float* df,
- const float* ef, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* ferr,
- float* berr, float* work );
-lapack_int LAPACKE_dptrfs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e,
- const double* df, const double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work );
-lapack_int LAPACKE_cptrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zptrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- const double* df,
- const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, float* e, float* b, lapack_int ldb );
-lapack_int LAPACKE_dptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- float* d, lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zptsv_work( int matrix_order, lapack_int n, lapack_int nrhs,
- double* d, lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d, const float* e,
- float* df, float* ef, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work );
-lapack_int LAPACKE_dptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const double* e, double* df, double* ef,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* ferr,
- double* berr, double* work );
-lapack_int LAPACKE_cptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zptsvx_work( int matrix_order, char fact, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e, double* df,
- lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_spttrf_work( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dpttrf_work( lapack_int n, double* d, double* e );
-lapack_int LAPACKE_cpttrf_work( lapack_int n, float* d,
- lapack_complex_float* e );
-lapack_int LAPACKE_zpttrf_work( lapack_int n, double* d,
- lapack_complex_double* e );
-
-lapack_int LAPACKE_spttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const float* d, const float* e, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dpttrs_work( int matrix_order, lapack_int n, lapack_int nrhs,
- const double* d, const double* e, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_cpttrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* d,
- const lapack_complex_float* e,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zpttrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* d,
- const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dsbev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsbevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- float* ab, lapack_int ldab, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int kd,
- double* ab, lapack_int ldab, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, const float* bb,
- lapack_int ldbb, float* x, lapack_int ldx,
- float* work );
-lapack_int LAPACKE_dsbgst_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, const double* bb,
- lapack_int ldbb, double* x, lapack_int ldx,
- double* work );
-
-lapack_int LAPACKE_ssbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dsbgv_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- float* ab, lapack_int ldab, float* bb,
- lapack_int ldbb, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsbgvd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, lapack_int ka, lapack_int kb,
- double* ab, lapack_int ldab, double* bb,
- lapack_int ldbb, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, float* ab, lapack_int ldab,
- float* bb, lapack_int ldbb, float* q,
- lapack_int ldq, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsbgvx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, lapack_int ka,
- lapack_int kb, double* ab, lapack_int ldab,
- double* bb, lapack_int ldbb, double* q,
- lapack_int ldq, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, float* ab,
- lapack_int ldab, float* d, float* e, float* q,
- lapack_int ldq, float* work );
-lapack_int LAPACKE_dsbtrd_work( int matrix_order, char vect, char uplo,
- lapack_int n, lapack_int kd, double* ab,
- lapack_int ldab, double* d, double* e,
- double* q, lapack_int ldq, double* work );
-
-lapack_int LAPACKE_ssfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- float alpha, const float* a, lapack_int lda,
- float beta, float* c );
-lapack_int LAPACKE_dsfrk_work( int matrix_order, char transr, char uplo,
- char trans, lapack_int n, lapack_int k,
- double alpha, const double* a, lapack_int lda,
- double beta, double* c );
-
-lapack_int LAPACKE_sspcon_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, const lapack_int* ipiv,
- float anorm, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dspcon_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, const lapack_int* ipiv,
- double anorm, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_cspcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zspcon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_sspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_dspev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_sspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* ap, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dspevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* ap, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* ap, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dspevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* ap, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_sspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* ap, const float* bp );
-lapack_int LAPACKE_dspgst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* ap, const double* bp );
-
-lapack_int LAPACKE_sspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dspgv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work );
-
-lapack_int LAPACKE_sspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* ap, float* bp,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dspgvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* ap, double* bp,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* ap,
- float* bp, float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_dspgvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* ap,
- double* bp, double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int* iwork,
- lapack_int* ifail );
-
-lapack_int LAPACKE_ssprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const float* afp, const lapack_int* ipiv,
- const float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dsprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const double* afp, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zsprfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_sspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* ap, lapack_int* ipiv,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* ap, lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_cspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zspsv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_sspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* ap,
- float* afp, lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* ap,
- double* afp, lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_cspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* afp, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zspsvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* afp, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_ssptrd_work( int matrix_order, char uplo, lapack_int n,
- float* ap, float* d, float* e, float* tau );
-lapack_int LAPACKE_dsptrd_work( int matrix_order, char uplo, lapack_int n,
- double* ap, double* d, double* e, double* tau );
-
-lapack_int LAPACKE_ssptrf_work( int matrix_order, char uplo, lapack_int n,
- float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_dsptrf_work( int matrix_order, char uplo, lapack_int n,
- double* ap, lapack_int* ipiv );
-lapack_int LAPACKE_csptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap, lapack_int* ipiv );
-lapack_int LAPACKE_zsptrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap, lapack_int* ipiv );
-
-lapack_int LAPACKE_ssptri_work( int matrix_order, char uplo, lapack_int n,
- float* ap, const lapack_int* ipiv,
- float* work );
-lapack_int LAPACKE_dsptri_work( int matrix_order, char uplo, lapack_int n,
- double* ap, const lapack_int* ipiv,
- double* work );
-lapack_int LAPACKE_csptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* ap,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsptri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* ap,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* ap,
- const lapack_int* ipiv, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_csptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_zsptrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sstebz_work( char range, char order, lapack_int n, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, const float* d, const float* e,
- lapack_int* m, lapack_int* nsplit, float* w,
- lapack_int* iblock, lapack_int* isplit,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dstebz_work( char range, char order, lapack_int n, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, const double* d, const double* e,
- lapack_int* m, lapack_int* nsplit, double* w,
- lapack_int* iblock, lapack_int* isplit,
- double* work, lapack_int* iwork );
-
-lapack_int LAPACKE_sstedc_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstedc_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstedc_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, lapack_complex_float* work,
- lapack_int lwork, float* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstedc_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, lapack_complex_double* work,
- lapack_int lwork, double* rwork,
- lapack_int lrwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_sstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstegr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* isuppz, double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_sstein_work( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock,
- const lapack_int* isplit, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_dstein_work( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock,
- const lapack_int* isplit, double* z,
- lapack_int ldz, double* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_cstein_work( int matrix_order, lapack_int n, const float* d,
- const float* e, lapack_int m, const float* w,
- const lapack_int* iblock,
- const lapack_int* isplit,
- lapack_complex_float* z, lapack_int ldz,
- float* work, lapack_int* iwork,
- lapack_int* ifailv );
-lapack_int LAPACKE_zstein_work( int matrix_order, lapack_int n, const double* d,
- const double* e, lapack_int m, const double* w,
- const lapack_int* iblock,
- const lapack_int* isplit,
- lapack_complex_double* z, lapack_int ldz,
- double* work, lapack_int* iwork,
- lapack_int* ifailv );
-
-lapack_int LAPACKE_sstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int nzc,
- lapack_int* isuppz, lapack_logical* tryrac,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_cstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_zstemr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int nzc, lapack_int* isuppz,
- lapack_logical* tryrac, double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_ssteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dsteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-lapack_int LAPACKE_csteqr_work( int matrix_order, char compz, lapack_int n,
- float* d, float* e, lapack_complex_float* z,
- lapack_int ldz, float* work );
-lapack_int LAPACKE_zsteqr_work( int matrix_order, char compz, lapack_int n,
- double* d, double* e, lapack_complex_double* z,
- lapack_int ldz, double* work );
-
-lapack_int LAPACKE_ssterf_work( lapack_int n, float* d, float* e );
-lapack_int LAPACKE_dsterf_work( lapack_int n, double* d, double* e );
-
-lapack_int LAPACKE_sstev_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work );
-lapack_int LAPACKE_dstev_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work );
-
-lapack_int LAPACKE_sstevd_work( int matrix_order, char jobz, lapack_int n,
- float* d, float* e, float* z, lapack_int ldz,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dstevd_work( int matrix_order, char jobz, lapack_int n,
- double* d, double* e, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dstevr_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_sstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, float* d, float* e, float vl,
- float vu, lapack_int il, lapack_int iu,
- float abstol, lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dstevx_work( int matrix_order, char jobz, char range,
- lapack_int n, double* d, double* e, double vl,
- double vu, lapack_int il, lapack_int iu,
- double abstol, lapack_int* m, double* w,
- double* z, lapack_int ldz, double* work,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssycon_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dsycon_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_csycon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, float anorm,
- float* rcond, lapack_complex_float* work );
-lapack_int LAPACKE_zsycon_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, double anorm,
- double* rcond, lapack_complex_double* work );
-
-lapack_int LAPACKE_ssyequb_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* s,
- float* scond, float* amax, float* work );
-lapack_int LAPACKE_dsyequb_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* s,
- double* scond, double* amax, double* work );
-lapack_int LAPACKE_csyequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* s, float* scond, float* amax,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsyequb_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* s, double* scond, double* amax,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda, float* w,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsyev_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, float* a, lapack_int lda,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsyevd_work( int matrix_order, char jobz, char uplo,
- lapack_int n, double* a, lapack_int lda,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, lapack_int* isuppz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dsyevr_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, lapack_int* isuppz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float vl, float vu,
- lapack_int il, lapack_int iu, float abstol,
- lapack_int* m, float* w, float* z,
- lapack_int ldz, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-lapack_int LAPACKE_dsyevx_work( int matrix_order, char jobz, char range,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double vl, double vu,
- lapack_int il, lapack_int iu, double abstol,
- lapack_int* m, double* w, double* z,
- lapack_int ldz, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, float* a, lapack_int lda,
- const float* b, lapack_int ldb );
-lapack_int LAPACKE_dsygst_work( int matrix_order, lapack_int itype, char uplo,
- lapack_int n, double* a, lapack_int lda,
- const double* b, lapack_int ldb );
-
-lapack_int LAPACKE_ssygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork );
-lapack_int LAPACKE_dsygv_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* w, float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dsygvd_work( int matrix_order, lapack_int itype, char jobz,
- char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* w, double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-
-lapack_int LAPACKE_ssygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float vl, float vu, lapack_int il,
- lapack_int iu, float abstol, lapack_int* m,
- float* w, float* z, lapack_int ldz, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int* ifail );
-lapack_int LAPACKE_dsygvx_work( int matrix_order, lapack_int itype, char jobz,
- char range, char uplo, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double vl, double vu, lapack_int il,
- lapack_int iu, double abstol, lapack_int* m,
- double* w, double* z, lapack_int ldz,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int* ifail );
-
-lapack_int LAPACKE_ssyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const float* af, lapack_int ldaf,
- const lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_zsyrfs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_ssyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, const float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const float* b, lapack_int ldb,
- float* x, lapack_int ldx, float* rcond,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, const double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_csyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const float* s, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zsyrfsx_work( int matrix_order, char uplo, char equed,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* af,
- lapack_int ldaf, const lapack_int* ipiv,
- const double* s,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_ssysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, float* a, lapack_int lda,
- lapack_int* ipiv, float* b, lapack_int ldb,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, double* a, lapack_int lda,
- lapack_int* ipiv, double* b, lapack_int ldb,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_csysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_float* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zsysv_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, lapack_complex_double* a,
- lapack_int lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, const float* b,
- lapack_int ldb, float* x, lapack_int ldx,
- float* rcond, float* ferr, float* berr,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dsysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, const double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, const double* b,
- lapack_int ldb, double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_csysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int ldb, lapack_complex_float* x,
- lapack_int ldx, float* rcond, float* ferr,
- float* berr, lapack_complex_float* work,
- lapack_int lwork, float* rwork );
-lapack_int LAPACKE_zsysvx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork );
-
-lapack_int LAPACKE_ssysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, float* a,
- lapack_int lda, float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- float* b, lapack_int ldb, float* x,
- lapack_int ldx, float* rcond, float* rpvgrw,
- float* berr, lapack_int n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int nparams, float* params, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dsysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs, double* a,
- lapack_int lda, double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- double* b, lapack_int ldb, double* x,
- lapack_int ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int nparams, double* params,
- double* work, lapack_int* iwork );
-lapack_int LAPACKE_csysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* x, lapack_int ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int nparams,
- float* params, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_zsysvxx_work( int matrix_order, char fact, char uplo,
- lapack_int n, lapack_int nrhs,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* af, lapack_int ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* x, lapack_int ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int nparams,
- double* params, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_ssytrd_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, float* d, float* e,
- float* tau, float* work, lapack_int lwork );
-lapack_int LAPACKE_dsytrd_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, double* d, double* e,
- double* tau, double* work, lapack_int lwork );
-
-lapack_int LAPACKE_ssytrf_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, lapack_int* ipiv,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dsytrf_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, lapack_int* ipiv,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_csytrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_float* work,
- lapack_int lwork );
-lapack_int LAPACKE_zsytrf_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_int* ipiv, lapack_complex_double* work,
- lapack_int lwork );
-
-lapack_int LAPACKE_ssytri_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work );
-lapack_int LAPACKE_dsytri_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work );
-lapack_int LAPACKE_csytri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_zsytri_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_ssytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dsytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const float* ab, lapack_int ldab, float* rcond,
- float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const double* ab, lapack_int ldab,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const lapack_complex_float* ab, lapack_int ldab,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_ztbcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, lapack_int kd,
- const lapack_complex_double* ab,
- lapack_int ldab, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, const lapack_complex_float* b,
- lapack_int ldb, const lapack_complex_float* x,
- lapack_int ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztbrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, const lapack_complex_double* b,
- lapack_int ldb, const lapack_complex_double* x,
- lapack_int ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const float* ab,
- lapack_int ldab, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const double* ab,
- lapack_int ldab, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs, const lapack_complex_float* ab,
- lapack_int ldab, lapack_complex_float* b,
- lapack_int ldb );
-lapack_int LAPACKE_ztbtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int kd,
- lapack_int nrhs,
- const lapack_complex_double* ab,
- lapack_int ldab, lapack_complex_double* b,
- lapack_int ldb );
-
-lapack_int LAPACKE_stfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, float alpha, const float* a,
- float* b, lapack_int ldb );
-lapack_int LAPACKE_dtfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, double alpha, const double* a,
- double* b, lapack_int ldb );
-lapack_int LAPACKE_ctfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, lapack_complex_float alpha,
- const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztfsm_work( int matrix_order, char transr, char side,
- char uplo, char trans, char diag, lapack_int m,
- lapack_int n, lapack_complex_double alpha,
- const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, float* a );
-lapack_int LAPACKE_dtftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n, double* a );
-lapack_int LAPACKE_ctftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n,
- lapack_complex_float* a );
-lapack_int LAPACKE_ztftri_work( int matrix_order, char transr, char uplo,
- char diag, lapack_int n,
- lapack_complex_double* a );
-
-lapack_int LAPACKE_stfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* ap );
-lapack_int LAPACKE_dtfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* ap );
-lapack_int LAPACKE_ctfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztfttp_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* arf, float* a,
- lapack_int lda );
-lapack_int LAPACKE_dtfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* arf, double* a,
- lapack_int lda );
-lapack_int LAPACKE_ctfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* arf,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztfttr_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* arf,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_stgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* s, lapack_int lds, const float* p,
- lapack_int ldp, float* vl, lapack_int ldvl,
- float* vr, lapack_int ldvr, lapack_int mm,
- lapack_int* m, float* work );
-lapack_int LAPACKE_dtgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* s, lapack_int lds,
- const double* p, lapack_int ldp, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work );
-lapack_int LAPACKE_ctgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* s, lapack_int lds,
- const lapack_complex_float* p, lapack_int ldp,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztgevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* s, lapack_int lds,
- const lapack_complex_double* p, lapack_int ldp,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, float* a,
- lapack_int lda, float* b, lapack_int ldb,
- float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_dtgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* q, lapack_int ldq, double* z,
- lapack_int ldz, lapack_int* ifst,
- lapack_int* ilst, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_ctgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztgexc_work( int matrix_order, lapack_logical wantq,
- lapack_logical wantz, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_stgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* alphar, float* alphai,
- float* beta, float* q, lapack_int ldq, float* z,
- lapack_int ldz, lapack_int* m, float* pl,
- float* pr, float* dif, float* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-lapack_int LAPACKE_dtgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double* alphar, double* alphai,
- double* beta, double* q, lapack_int ldq,
- double* z, lapack_int ldz, lapack_int* m,
- double* pl, double* pr, double* dif,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ctgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* alpha,
- lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* z, lapack_int ldz,
- lapack_int* m, float* pl, float* pr, float* dif,
- lapack_complex_float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ztgsen_work( int matrix_order, lapack_int ijob,
- lapack_logical wantq, lapack_logical wantz,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* alpha,
- lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* z, lapack_int ldz,
- lapack_int* m, double* pl, double* pr,
- double* dif, lapack_complex_double* work,
- lapack_int lwork, lapack_int* iwork,
- lapack_int liwork );
-
-lapack_int LAPACKE_stgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float tola, float tolb,
- float* alpha, float* beta, float* u,
- lapack_int ldu, float* v, lapack_int ldv,
- float* q, lapack_int ldq, float* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_dtgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- double* a, lapack_int lda, double* b,
- lapack_int ldb, double tola, double tolb,
- double* alpha, double* beta, double* u,
- lapack_int ldu, double* v, lapack_int ldv,
- double* q, lapack_int ldq, double* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_ctgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- float tola, float tolb, float* alpha,
- float* beta, lapack_complex_float* u,
- lapack_int ldu, lapack_complex_float* v,
- lapack_int ldv, lapack_complex_float* q,
- lapack_int ldq, lapack_complex_float* work,
- lapack_int* ncycle );
-lapack_int LAPACKE_ztgsja_work( int matrix_order, char jobu, char jobv,
- char jobq, lapack_int m, lapack_int p,
- lapack_int n, lapack_int k, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- double tola, double tolb, double* alpha,
- double* beta, lapack_complex_double* u,
- lapack_int ldu, lapack_complex_double* v,
- lapack_int ldv, lapack_complex_double* q,
- lapack_int ldq, lapack_complex_double* work,
- lapack_int* ncycle );
-
-lapack_int LAPACKE_stgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* dif,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_dtgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* dif, lapack_int mm, lapack_int* m,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* dif, lapack_int mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int lwork, lapack_int* iwork );
-lapack_int LAPACKE_ztgsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* vl,
- lapack_int ldvl,
- const lapack_complex_double* vr,
- lapack_int ldvr, double* s, double* dif,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_stgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const float* a,
- lapack_int lda, const float* b, lapack_int ldb,
- float* c, lapack_int ldc, const float* d,
- lapack_int ldd, const float* e, lapack_int lde,
- float* f, lapack_int ldf, float* scale,
- float* dif, float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dtgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n, const double* a,
- lapack_int lda, const double* b, lapack_int ldb,
- double* c, lapack_int ldc, const double* d,
- lapack_int ldd, const double* e, lapack_int lde,
- double* f, lapack_int ldf, double* scale,
- double* dif, double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- const lapack_complex_float* d, lapack_int ldd,
- const lapack_complex_float* e, lapack_int lde,
- lapack_complex_float* f, lapack_int ldf,
- float* scale, float* dif,
- lapack_complex_float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ztgsyl_work( int matrix_order, char trans, lapack_int ijob,
- lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- const lapack_complex_double* d, lapack_int ldd,
- const lapack_complex_double* e, lapack_int lde,
- lapack_complex_double* f, lapack_int ldf,
- double* scale, double* dif,
- lapack_complex_double* work, lapack_int lwork,
- lapack_int* iwork );
-
-lapack_int LAPACKE_stpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* ap,
- float* rcond, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* ap,
- double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_float* ap, float* rcond,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztpcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_double* ap, double* rcond,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, const float* b, lapack_int ldb,
- const float* x, lapack_int ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork );
-lapack_int LAPACKE_dtprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, const double* b,
- lapack_int ldb, const double* x, lapack_int ldx,
- double* ferr, double* berr, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztprfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_stptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* ap );
-lapack_int LAPACKE_dtptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* ap );
-lapack_int LAPACKE_ctptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_float* ap );
-lapack_int LAPACKE_ztptri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_double* ap );
-
-lapack_int LAPACKE_stptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* ap, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* ap, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztptrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_stpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* ap, float* arf );
-lapack_int LAPACKE_dtpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* ap, double* arf );
-lapack_int LAPACKE_ctpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* ap,
- lapack_complex_float* arf );
-lapack_int LAPACKE_ztpttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* ap,
- lapack_complex_double* arf );
-
-lapack_int LAPACKE_stpttr_work( int matrix_order, char uplo, lapack_int n,
- const float* ap, float* a, lapack_int lda );
-lapack_int LAPACKE_dtpttr_work( int matrix_order, char uplo, lapack_int n,
- const double* ap, double* a, lapack_int lda );
-lapack_int LAPACKE_ctpttr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_ztpttr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_strcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const float* a,
- lapack_int lda, float* rcond, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dtrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n, const double* a,
- lapack_int lda, double* rcond, double* work,
- lapack_int* iwork );
-lapack_int LAPACKE_ctrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- float* rcond, lapack_complex_float* work,
- float* rwork );
-lapack_int LAPACKE_ztrcon_work( int matrix_order, char norm, char uplo,
- char diag, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- double* rcond, lapack_complex_double* work,
- double* rwork );
-
-lapack_int LAPACKE_strevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, float* vl,
- lapack_int ldvl, float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, float* work );
-lapack_int LAPACKE_dtrevc_work( int matrix_order, char side, char howmny,
- lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt, double* vl,
- lapack_int ldvl, double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m, double* work );
-lapack_int LAPACKE_ctrevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* vl, lapack_int ldvl,
- lapack_complex_float* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztrevc_work( int matrix_order, char side, char howmny,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* vl, lapack_int ldvl,
- lapack_complex_double* vr, lapack_int ldvr,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_strexc_work( int matrix_order, char compq, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, float* work );
-lapack_int LAPACKE_dtrexc_work( int matrix_order, char compq, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, lapack_int* ifst,
- lapack_int* ilst, double* work );
-lapack_int LAPACKE_ctrexc_work( int matrix_order, char compq, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-lapack_int LAPACKE_ztrexc_work( int matrix_order, char compq, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_int ifst, lapack_int ilst );
-
-lapack_int LAPACKE_strrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, const float* x, lapack_int ldx,
- float* ferr, float* berr, float* work,
- lapack_int* iwork );
-lapack_int LAPACKE_dtrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb,
- const double* x, lapack_int ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork );
-lapack_int LAPACKE_ctrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- const lapack_complex_float* x, lapack_int ldx,
- float* ferr, float* berr,
- lapack_complex_float* work, float* rwork );
-lapack_int LAPACKE_ztrrfs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- const lapack_complex_double* x, lapack_int ldx,
- double* ferr, double* berr,
- lapack_complex_double* work, double* rwork );
-
-lapack_int LAPACKE_strsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- float* t, lapack_int ldt, float* q,
- lapack_int ldq, float* wr, float* wi,
- lapack_int* m, float* s, float* sep,
- float* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_dtrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- double* t, lapack_int ldt, double* q,
- lapack_int ldq, double* wr, double* wi,
- lapack_int* m, double* s, double* sep,
- double* work, lapack_int lwork,
- lapack_int* iwork, lapack_int liwork );
-lapack_int LAPACKE_ctrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* w, lapack_int* m,
- float* s, float* sep,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ztrsen_work( int matrix_order, char job, char compq,
- const lapack_logical* select, lapack_int n,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* w, lapack_int* m,
- double* s, double* sep,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_strsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const float* t, lapack_int ldt, const float* vl,
- lapack_int ldvl, const float* vr,
- lapack_int ldvr, float* s, float* sep,
- lapack_int mm, lapack_int* m, float* work,
- lapack_int ldwork, lapack_int* iwork );
-lapack_int LAPACKE_dtrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const double* t, lapack_int ldt,
- const double* vl, lapack_int ldvl,
- const double* vr, lapack_int ldvr, double* s,
- double* sep, lapack_int mm, lapack_int* m,
- double* work, lapack_int ldwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ctrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_float* t, lapack_int ldt,
- const lapack_complex_float* vl, lapack_int ldvl,
- const lapack_complex_float* vr, lapack_int ldvr,
- float* s, float* sep, lapack_int mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int ldwork, float* rwork );
-lapack_int LAPACKE_ztrsna_work( int matrix_order, char job, char howmny,
- const lapack_logical* select, lapack_int n,
- const lapack_complex_double* t, lapack_int ldt,
- const lapack_complex_double* vl,
- lapack_int ldvl,
- const lapack_complex_double* vr,
- lapack_int ldvr, double* s, double* sep,
- lapack_int mm, lapack_int* m,
- lapack_complex_double* work, lapack_int ldwork,
- double* rwork );
-
-lapack_int LAPACKE_strsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const float* a, lapack_int lda, const float* b,
- lapack_int ldb, float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_dtrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const double* a, lapack_int lda,
- const double* b, lapack_int ldb, double* c,
- lapack_int ldc, double* scale );
-lapack_int LAPACKE_ctrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* c, lapack_int ldc,
- float* scale );
-lapack_int LAPACKE_ztrsyl_work( int matrix_order, char trana, char tranb,
- lapack_int isgn, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* c, lapack_int ldc,
- double* scale );
-
-lapack_int LAPACKE_strtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, float* a, lapack_int lda );
-lapack_int LAPACKE_dtrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, double* a, lapack_int lda );
-lapack_int LAPACKE_ctrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_ztrtri_work( int matrix_order, char uplo, char diag,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda );
-
-lapack_int LAPACKE_strtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztrtrs_work( int matrix_order, char uplo, char trans,
- char diag, lapack_int n, lapack_int nrhs,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_strttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const float* a, lapack_int lda,
- float* arf );
-lapack_int LAPACKE_dtrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const double* a, lapack_int lda,
- double* arf );
-lapack_int LAPACKE_ctrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* arf );
-lapack_int LAPACKE_ztrttf_work( int matrix_order, char transr, char uplo,
- lapack_int n, const lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* arf );
-
-lapack_int LAPACKE_strttp_work( int matrix_order, char uplo, lapack_int n,
- const float* a, lapack_int lda, float* ap );
-lapack_int LAPACKE_dtrttp_work( int matrix_order, char uplo, lapack_int n,
- const double* a, lapack_int lda, double* ap );
-lapack_int LAPACKE_ctrttp_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* ap );
-lapack_int LAPACKE_ztrttp_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* ap );
-
-lapack_int LAPACKE_stzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* tau,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_dtzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* tau,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_ctzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ztzrzf_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungbr_work( int matrix_order, char vect, lapack_int m,
- lapack_int n, lapack_int k,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunghr_work( int matrix_order, lapack_int n, lapack_int ilo,
- lapack_int ihi, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunglq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungql_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungqr_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungrq_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int k, lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cungtr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zungtr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmbr_work( int matrix_order, char vect, char side,
- char trans, lapack_int m, lapack_int n,
- lapack_int k, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmhr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int ilo,
- lapack_int ihi, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmlq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmql_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmqr_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmrq_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_float* a,
- lapack_int lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmrz_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, const lapack_complex_double* a,
- lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cunmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_float* a, lapack_int lda,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_zunmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_double* a, lapack_int lda,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work, lapack_int lwork );
-
-lapack_int LAPACKE_cupgtr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* q, lapack_int ldq,
- lapack_complex_float* work );
-lapack_int LAPACKE_zupgtr_work( int matrix_order, char uplo, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* q, lapack_int ldq,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_cupmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_float* ap,
- const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int ldc,
- lapack_complex_float* work );
-lapack_int LAPACKE_zupmtr_work( int matrix_order, char side, char uplo,
- char trans, lapack_int m, lapack_int n,
- const lapack_complex_double* ap,
- const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int ldc,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_claghe( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_zlaghe( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed );
-
-lapack_int LAPACKE_slagsy( int matrix_order, lapack_int n, lapack_int k,
- const float* d, float* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_dlagsy( int matrix_order, lapack_int n, lapack_int k,
- const double* d, double* a, lapack_int lda,
- lapack_int* iseed );
-lapack_int LAPACKE_clagsy( int matrix_order, lapack_int n, lapack_int k,
- const float* d, lapack_complex_float* a,
- lapack_int lda, lapack_int* iseed );
-lapack_int LAPACKE_zlagsy( int matrix_order, lapack_int n, lapack_int k,
- const double* d, lapack_complex_double* a,
- lapack_int lda, lapack_int* iseed );
-
-lapack_int LAPACKE_slapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, float* x, lapack_int ldx,
- lapack_int* k );
-lapack_int LAPACKE_dlapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, double* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_clapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, lapack_complex_float* x,
- lapack_int ldx, lapack_int* k );
-lapack_int LAPACKE_zlapmr( int matrix_order, lapack_logical forwrd,
- lapack_int m, lapack_int n, lapack_complex_double* x,
- lapack_int ldx, lapack_int* k );
-
-
-float LAPACKE_slapy2( float x, float y );
-double LAPACKE_dlapy2( double x, double y );
-
-float LAPACKE_slapy3( float x, float y, float z );
-double LAPACKE_dlapy3( double x, double y, double z );
-
-lapack_int LAPACKE_slartgp( float f, float g, float* cs, float* sn, float* r );
-lapack_int LAPACKE_dlartgp( double f, double g, double* cs, double* sn,
- double* r );
-
-lapack_int LAPACKE_slartgs( float x, float y, float sigma, float* cs,
- float* sn );
-lapack_int LAPACKE_dlartgs( double x, double y, double sigma, double* cs,
- double* sn );
-
-
-//LAPACK 3.3.0
-lapack_int LAPACKE_cbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, float* theta, float* phi,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- float* b11d, float* b11e, float* b12d, float* b12e,
- float* b21d, float* b21e, float* b22d, float* b22e );
-lapack_int LAPACKE_cbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- float* theta, float* phi,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- float* b11d, float* b11e, float* b12d,
- float* b12e, float* b21d, float* b21e,
- float* b22d, float* b22e, float* rwork,
- lapack_int lrwork );
-lapack_int LAPACKE_cheswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_cheswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_chetri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_chetri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_chetri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_chetri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int nb );
-lapack_int LAPACKE_chetrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_chetrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_csyconv( int matrix_order, char uplo, char way, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_csyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* work );
-lapack_int LAPACKE_csyswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_csyswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_csytri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_csytri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_csytri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_csytri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int nb );
-lapack_int LAPACKE_csytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_csytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_float* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_cunbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2 );
-lapack_int LAPACKE_cunbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_cuncsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_float* x11, lapack_int ldx11,
- lapack_complex_float* x12, lapack_int ldx12,
- lapack_complex_float* x21, lapack_int ldx21,
- lapack_complex_float* x22, lapack_int ldx22,
- float* theta, lapack_complex_float* u1,
- lapack_int ldu1, lapack_complex_float* u2,
- lapack_int ldu2, lapack_complex_float* v1t,
- lapack_int ldv1t, lapack_complex_float* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_cuncsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, lapack_complex_float* x11,
- lapack_int ldx11, lapack_complex_float* x12,
- lapack_int ldx12, lapack_complex_float* x21,
- lapack_int ldx21, lapack_complex_float* x22,
- lapack_int ldx22, float* theta,
- lapack_complex_float* u1, lapack_int ldu1,
- lapack_complex_float* u2, lapack_int ldu2,
- lapack_complex_float* v1t, lapack_int ldv1t,
- lapack_complex_float* v2t, lapack_int ldv2t,
- lapack_complex_float* work, lapack_int lwork,
- float* rwork, lapack_int lrwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, double* theta,
- double* phi, double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t, double* b11d,
- double* b11e, double* b12d, double* b12e,
- double* b21d, double* b21e, double* b22d,
- double* b22e );
-lapack_int LAPACKE_dbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- double* theta, double* phi, double* u1,
- lapack_int ldu1, double* u2, lapack_int ldu2,
- double* v1t, lapack_int ldv1t, double* v2t,
- lapack_int ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e,
- double* work, lapack_int lwork );
-lapack_int LAPACKE_dorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2 );
-lapack_int LAPACKE_dorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2, double* work,
- lapack_int lwork );
-lapack_int LAPACKE_dorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- double* x11, lapack_int ldx11, double* x12,
- lapack_int ldx12, double* x21, lapack_int ldx21,
- double* x22, lapack_int ldx22, double* theta,
- double* u1, lapack_int ldu1, double* u2,
- lapack_int ldu2, double* v1t, lapack_int ldv1t,
- double* v2t, lapack_int ldv2t );
-lapack_int LAPACKE_dorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, double* x11, lapack_int ldx11,
- double* x12, lapack_int ldx12, double* x21,
- lapack_int ldx21, double* x22, lapack_int ldx22,
- double* theta, double* u1, lapack_int ldu1,
- double* u2, lapack_int ldu2, double* v1t,
- lapack_int ldv1t, double* v2t, lapack_int ldv2t,
- double* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_dsyconv( int matrix_order, char uplo, char way, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, double* a, lapack_int lda,
- const lapack_int* ipiv, double* work );
-lapack_int LAPACKE_dsyswapr( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_dsyswapr_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_dsytri2( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_dsytri2_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_dsytri2x( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb );
-lapack_int LAPACKE_dsytri2x_work( int matrix_order, char uplo, lapack_int n,
- double* a, lapack_int lda,
- const lapack_int* ipiv, double* work,
- lapack_int nb );
-lapack_int LAPACKE_dsytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a, lapack_int lda,
- const lapack_int* ipiv, double* b, lapack_int ldb );
-lapack_int LAPACKE_dsytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const double* a,
- lapack_int lda, const lapack_int* ipiv,
- double* b, lapack_int ldb, double* work );
-lapack_int LAPACKE_sbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, float* theta, float* phi,
- float* u1, lapack_int ldu1, float* u2,
- lapack_int ldu2, float* v1t, lapack_int ldv1t,
- float* v2t, lapack_int ldv2t, float* b11d,
- float* b11e, float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e );
-lapack_int LAPACKE_sbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- float* theta, float* phi, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t, float* b11d, float* b11e,
- float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e,
- float* work, lapack_int lwork );
-lapack_int LAPACKE_sorbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* phi,
- float* taup1, float* taup2, float* tauq1,
- float* tauq2 );
-lapack_int LAPACKE_sorbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- float* x11, lapack_int ldx11, float* x12,
- lapack_int ldx12, float* x21, lapack_int ldx21,
- float* x22, lapack_int ldx22, float* theta,
- float* phi, float* taup1, float* taup2,
- float* tauq1, float* tauq2, float* work,
- lapack_int lwork );
-lapack_int LAPACKE_sorcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q, float* x11,
- lapack_int ldx11, float* x12, lapack_int ldx12,
- float* x21, lapack_int ldx21, float* x22,
- lapack_int ldx22, float* theta, float* u1,
- lapack_int ldu1, float* u2, lapack_int ldu2,
- float* v1t, lapack_int ldv1t, float* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_sorcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, float* x11, lapack_int ldx11,
- float* x12, lapack_int ldx12, float* x21,
- lapack_int ldx21, float* x22, lapack_int ldx22,
- float* theta, float* u1, lapack_int ldu1,
- float* u2, lapack_int ldu2, float* v1t,
- lapack_int ldv1t, float* v2t, lapack_int ldv2t,
- float* work, lapack_int lwork,
- lapack_int* iwork );
-lapack_int LAPACKE_ssyconv( int matrix_order, char uplo, char way, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_ssyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, float* a, lapack_int lda,
- const lapack_int* ipiv, float* work );
-lapack_int LAPACKE_ssyswapr( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_ssyswapr_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int i1, lapack_int i2 );
-lapack_int LAPACKE_ssytri2( int matrix_order, char uplo, lapack_int n, float* a,
- lapack_int lda, const lapack_int* ipiv );
-lapack_int LAPACKE_ssytri2_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int lwork );
-lapack_int LAPACKE_ssytri2x( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda, const lapack_int* ipiv,
- lapack_int nb );
-lapack_int LAPACKE_ssytri2x_work( int matrix_order, char uplo, lapack_int n,
- float* a, lapack_int lda,
- const lapack_int* ipiv, float* work,
- lapack_int nb );
-lapack_int LAPACKE_ssytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a, lapack_int lda,
- const lapack_int* ipiv, float* b, lapack_int ldb );
-lapack_int LAPACKE_ssytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const float* a,
- lapack_int lda, const lapack_int* ipiv,
- float* b, lapack_int ldb, float* work );
-lapack_int LAPACKE_zbbcsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, lapack_int m,
- lapack_int p, lapack_int q, double* theta,
- double* phi, lapack_complex_double* u1,
- lapack_int ldu1, lapack_complex_double* u2,
- lapack_int ldu2, lapack_complex_double* v1t,
- lapack_int ldv1t, lapack_complex_double* v2t,
- lapack_int ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e );
-lapack_int LAPACKE_zbbcsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- lapack_int m, lapack_int p, lapack_int q,
- double* theta, double* phi,
- lapack_complex_double* u1, lapack_int ldu1,
- lapack_complex_double* u2, lapack_int ldu2,
- lapack_complex_double* v1t, lapack_int ldv1t,
- lapack_complex_double* v2t, lapack_int ldv2t,
- double* b11d, double* b11e, double* b12d,
- double* b12e, double* b21d, double* b21e,
- double* b22d, double* b22e, double* rwork,
- lapack_int lrwork );
-lapack_int LAPACKE_zheswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zheswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zhetri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zhetri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zhetri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_zhetri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int nb );
-lapack_int LAPACKE_zhetrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-lapack_int LAPACKE_zhetrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-lapack_int LAPACKE_zsyconv( int matrix_order, char uplo, char way, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsyconv_work( int matrix_order, char uplo, char way,
- lapack_int n, lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* work );
-lapack_int LAPACKE_zsyswapr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zsyswapr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int i1,
- lapack_int i2 );
-lapack_int LAPACKE_zsytri2( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv );
-lapack_int LAPACKE_zsytri2_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zsytri2x( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv, lapack_int nb );
-lapack_int LAPACKE_zsytri2x_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int nb );
-lapack_int LAPACKE_zsytrs2( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb );
-lapack_int LAPACKE_zsytrs2_work( int matrix_order, char uplo, lapack_int n,
- lapack_int nrhs, const lapack_complex_double* a,
- lapack_int lda, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-lapack_int LAPACKE_zunbdb( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2 );
-lapack_int LAPACKE_zunbdb_work( int matrix_order, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2,
- lapack_complex_double* work, lapack_int lwork );
-lapack_int LAPACKE_zuncsd( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans, char signs,
- lapack_int m, lapack_int p, lapack_int q,
- lapack_complex_double* x11, lapack_int ldx11,
- lapack_complex_double* x12, lapack_int ldx12,
- lapack_complex_double* x21, lapack_int ldx21,
- lapack_complex_double* x22, lapack_int ldx22,
- double* theta, lapack_complex_double* u1,
- lapack_int ldu1, lapack_complex_double* u2,
- lapack_int ldu2, lapack_complex_double* v1t,
- lapack_int ldv1t, lapack_complex_double* v2t,
- lapack_int ldv2t );
-lapack_int LAPACKE_zuncsd_work( int matrix_order, char jobu1, char jobu2,
- char jobv1t, char jobv2t, char trans,
- char signs, lapack_int m, lapack_int p,
- lapack_int q, lapack_complex_double* x11,
- lapack_int ldx11, lapack_complex_double* x12,
- lapack_int ldx12, lapack_complex_double* x21,
- lapack_int ldx21, lapack_complex_double* x22,
- lapack_int ldx22, double* theta,
- lapack_complex_double* u1, lapack_int ldu1,
- lapack_complex_double* u2, lapack_int ldu2,
- lapack_complex_double* v1t, lapack_int ldv1t,
- lapack_complex_double* v2t, lapack_int ldv2t,
- lapack_complex_double* work, lapack_int lwork,
- double* rwork, lapack_int lrwork,
- lapack_int* iwork );
-//LAPACK 3.4.0
-lapack_int LAPACKE_sgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc );
-lapack_int LAPACKE_dgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc );
-lapack_int LAPACKE_cgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc );
-lapack_int LAPACKE_zgemqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc );
-
-lapack_int LAPACKE_sgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* t,
- lapack_int ldt );
-lapack_int LAPACKE_zgeqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* t,
- lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt2( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt3( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b,
- lapack_int ldb );
-lapack_int LAPACKE_dtpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b,
- lapack_int ldb );
-lapack_int LAPACKE_ctpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztpmqrt( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_dtpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_ctpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda,
- float* b, lapack_int ldb,
- float* t, lapack_int ldt );
-lapack_int LAPACKE_dtpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda,
- double* b, lapack_int ldb,
- double* t, lapack_int ldt );
-lapack_int LAPACKE_ctpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt2( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b, lapack_int ldb );
-lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l, const double* v,
- lapack_int ldv, const double* t, lapack_int ldt,
- double* a, lapack_int lda, double* b, lapack_int ldb );
-lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb );
-lapack_int LAPACKE_ztprfb( int matrix_order, char side, char trans, char direct,
- char storev, lapack_int m, lapack_int n,
- lapack_int k, lapack_int l,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb );
-
-lapack_int LAPACKE_sgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const float* v, lapack_int ldv,
- const float* t, lapack_int ldt, float* c,
- lapack_int ldc, float* work );
-lapack_int LAPACKE_dgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* c,
- lapack_int ldc, double* work );
-lapack_int LAPACKE_cgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_float* v,
- lapack_int ldv, const lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* c,
- lapack_int ldc, lapack_complex_float* work );
-lapack_int LAPACKE_zgemqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int nb, const lapack_complex_double* v,
- lapack_int ldv, const lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* c,
- lapack_int ldc, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, float* a, lapack_int lda,
- float* t, lapack_int ldt, float* work );
-lapack_int LAPACKE_dgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, double* a, lapack_int lda,
- double* t, lapack_int ldt, double* work );
-lapack_int LAPACKE_cgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_float* a,
- lapack_int lda, lapack_complex_float* t,
- lapack_int ldt, lapack_complex_float* work );
-lapack_int LAPACKE_zgeqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int nb, lapack_complex_double* a,
- lapack_int lda, lapack_complex_double* t,
- lapack_int ldt, lapack_complex_double* work );
-
-lapack_int LAPACKE_sgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt2_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_sgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- float* a, lapack_int lda, float* t,
- lapack_int ldt );
-lapack_int LAPACKE_dgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- double* a, lapack_int lda, double* t,
- lapack_int ldt );
-lapack_int LAPACKE_cgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_zgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const float* v,
- lapack_int ldv, const float* t, lapack_int ldt,
- float* a, lapack_int lda, float* b,
- lapack_int ldb, float* work );
-lapack_int LAPACKE_dtpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb, const double* v,
- lapack_int ldv, const double* t,
- lapack_int ldt, double* a, lapack_int lda,
- double* b, lapack_int ldb, double* work );
-lapack_int LAPACKE_ctpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* work );
-lapack_int LAPACKE_ztpmqrt_work( int matrix_order, char side, char trans,
- lapack_int m, lapack_int n, lapack_int k,
- lapack_int l, lapack_int nb,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_dtpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- double* t, lapack_int ldt, double* work );
-lapack_int LAPACKE_ctpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* work );
-lapack_int LAPACKE_ztpqrt_work( int matrix_order, lapack_int m, lapack_int n,
- lapack_int l, lapack_int nb,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* work );
-
-lapack_int LAPACKE_stpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- float* a, lapack_int lda,
- float* b, lapack_int ldb,
- float* t, lapack_int ldt );
-lapack_int LAPACKE_dtpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- double* a, lapack_int lda,
- double* b, lapack_int ldb,
- double* t, lapack_int ldt );
-lapack_int LAPACKE_ctpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- lapack_complex_float* t, lapack_int ldt );
-lapack_int LAPACKE_ztpqrt2_work( int matrix_order,
- lapack_int m, lapack_int n, lapack_int l,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- lapack_complex_double* t, lapack_int ldt );
-
-lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const float* v, lapack_int ldv, const float* t,
- lapack_int ldt, float* a, lapack_int lda,
- float* b, lapack_int ldb, const float* work,
- lapack_int ldwork );
-lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const double* v, lapack_int ldv,
- const double* t, lapack_int ldt, double* a,
- lapack_int lda, double* b, lapack_int ldb,
- const double* work, lapack_int ldwork );
-lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const lapack_complex_float* v, lapack_int ldv,
- const lapack_complex_float* t, lapack_int ldt,
- lapack_complex_float* a, lapack_int lda,
- lapack_complex_float* b, lapack_int ldb,
- const float* work, lapack_int ldwork );
-lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans,
- char direct, char storev, lapack_int m,
- lapack_int n, lapack_int k, lapack_int l,
- const lapack_complex_double* v, lapack_int ldv,
- const lapack_complex_double* t, lapack_int ldt,
- lapack_complex_double* a, lapack_int lda,
- lapack_complex_double* b, lapack_int ldb,
- const double* work, lapack_int ldwork );
-//LAPACK 3.X.X
-lapack_int LAPACKE_csyr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* x, lapack_int incx,
- lapack_complex_float* a, lapack_int lda );
-lapack_int LAPACKE_zsyr( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* x, lapack_int incx,
- lapack_complex_double* a, lapack_int lda );
-
-lapack_int LAPACKE_csyr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_float alpha,
- const lapack_complex_float* x,
- lapack_int incx, lapack_complex_float* a,
- lapack_int lda );
-lapack_int LAPACKE_zsyr_work( int matrix_order, char uplo, lapack_int n,
- lapack_complex_double alpha,
- const lapack_complex_double* x,
- lapack_int incx, lapack_complex_double* a,
- lapack_int lda );
-void LAPACKE_ilaver( const lapack_int* vers_major,
- const lapack_int* vers_minor,
- const lapack_int* vers_patch );
-
-
-#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF)
-#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF)
-#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF)
-#define LAPACK_zgetrf LAPACK_GLOBAL(zgetrf,ZGETRF)
-#define LAPACK_sgbtrf LAPACK_GLOBAL(sgbtrf,SGBTRF)
-#define LAPACK_dgbtrf LAPACK_GLOBAL(dgbtrf,DGBTRF)
-#define LAPACK_cgbtrf LAPACK_GLOBAL(cgbtrf,CGBTRF)
-#define LAPACK_zgbtrf LAPACK_GLOBAL(zgbtrf,ZGBTRF)
-#define LAPACK_sgttrf LAPACK_GLOBAL(sgttrf,SGTTRF)
-#define LAPACK_dgttrf LAPACK_GLOBAL(dgttrf,DGTTRF)
-#define LAPACK_cgttrf LAPACK_GLOBAL(cgttrf,CGTTRF)
-#define LAPACK_zgttrf LAPACK_GLOBAL(zgttrf,ZGTTRF)
-#define LAPACK_spotrf LAPACK_GLOBAL(spotrf,SPOTRF)
-#define LAPACK_dpotrf LAPACK_GLOBAL(dpotrf,DPOTRF)
-#define LAPACK_cpotrf LAPACK_GLOBAL(cpotrf,CPOTRF)
-#define LAPACK_zpotrf LAPACK_GLOBAL(zpotrf,ZPOTRF)
-#define LAPACK_dpstrf LAPACK_GLOBAL(dpstrf,DPSTRF)
-#define LAPACK_spstrf LAPACK_GLOBAL(spstrf,SPSTRF)
-#define LAPACK_zpstrf LAPACK_GLOBAL(zpstrf,ZPSTRF)
-#define LAPACK_cpstrf LAPACK_GLOBAL(cpstrf,CPSTRF)
-#define LAPACK_dpftrf LAPACK_GLOBAL(dpftrf,DPFTRF)
-#define LAPACK_spftrf LAPACK_GLOBAL(spftrf,SPFTRF)
-#define LAPACK_zpftrf LAPACK_GLOBAL(zpftrf,ZPFTRF)
-#define LAPACK_cpftrf LAPACK_GLOBAL(cpftrf,CPFTRF)
-#define LAPACK_spptrf LAPACK_GLOBAL(spptrf,SPPTRF)
-#define LAPACK_dpptrf LAPACK_GLOBAL(dpptrf,DPPTRF)
-#define LAPACK_cpptrf LAPACK_GLOBAL(cpptrf,CPPTRF)
-#define LAPACK_zpptrf LAPACK_GLOBAL(zpptrf,ZPPTRF)
-#define LAPACK_spbtrf LAPACK_GLOBAL(spbtrf,SPBTRF)
-#define LAPACK_dpbtrf LAPACK_GLOBAL(dpbtrf,DPBTRF)
-#define LAPACK_cpbtrf LAPACK_GLOBAL(cpbtrf,CPBTRF)
-#define LAPACK_zpbtrf LAPACK_GLOBAL(zpbtrf,ZPBTRF)
-#define LAPACK_spttrf LAPACK_GLOBAL(spttrf,SPTTRF)
-#define LAPACK_dpttrf LAPACK_GLOBAL(dpttrf,DPTTRF)
-#define LAPACK_cpttrf LAPACK_GLOBAL(cpttrf,CPTTRF)
-#define LAPACK_zpttrf LAPACK_GLOBAL(zpttrf,ZPTTRF)
-#define LAPACK_ssytrf LAPACK_GLOBAL(ssytrf,SSYTRF)
-#define LAPACK_dsytrf LAPACK_GLOBAL(dsytrf,DSYTRF)
-#define LAPACK_csytrf LAPACK_GLOBAL(csytrf,CSYTRF)
-#define LAPACK_zsytrf LAPACK_GLOBAL(zsytrf,ZSYTRF)
-#define LAPACK_chetrf LAPACK_GLOBAL(chetrf,CHETRF)
-#define LAPACK_zhetrf LAPACK_GLOBAL(zhetrf,ZHETRF)
-#define LAPACK_ssptrf LAPACK_GLOBAL(ssptrf,SSPTRF)
-#define LAPACK_dsptrf LAPACK_GLOBAL(dsptrf,DSPTRF)
-#define LAPACK_csptrf LAPACK_GLOBAL(csptrf,CSPTRF)
-#define LAPACK_zsptrf LAPACK_GLOBAL(zsptrf,ZSPTRF)
-#define LAPACK_chptrf LAPACK_GLOBAL(chptrf,CHPTRF)
-#define LAPACK_zhptrf LAPACK_GLOBAL(zhptrf,ZHPTRF)
-#define LAPACK_sgetrs LAPACK_GLOBAL(sgetrs,SGETRS)
-#define LAPACK_dgetrs LAPACK_GLOBAL(dgetrs,DGETRS)
-#define LAPACK_cgetrs LAPACK_GLOBAL(cgetrs,CGETRS)
-#define LAPACK_zgetrs LAPACK_GLOBAL(zgetrs,ZGETRS)
-#define LAPACK_sgbtrs LAPACK_GLOBAL(sgbtrs,SGBTRS)
-#define LAPACK_dgbtrs LAPACK_GLOBAL(dgbtrs,DGBTRS)
-#define LAPACK_cgbtrs LAPACK_GLOBAL(cgbtrs,CGBTRS)
-#define LAPACK_zgbtrs LAPACK_GLOBAL(zgbtrs,ZGBTRS)
-#define LAPACK_sgttrs LAPACK_GLOBAL(sgttrs,SGTTRS)
-#define LAPACK_dgttrs LAPACK_GLOBAL(dgttrs,DGTTRS)
-#define LAPACK_cgttrs LAPACK_GLOBAL(cgttrs,CGTTRS)
-#define LAPACK_zgttrs LAPACK_GLOBAL(zgttrs,ZGTTRS)
-#define LAPACK_spotrs LAPACK_GLOBAL(spotrs,SPOTRS)
-#define LAPACK_dpotrs LAPACK_GLOBAL(dpotrs,DPOTRS)
-#define LAPACK_cpotrs LAPACK_GLOBAL(cpotrs,CPOTRS)
-#define LAPACK_zpotrs LAPACK_GLOBAL(zpotrs,ZPOTRS)
-#define LAPACK_dpftrs LAPACK_GLOBAL(dpftrs,DPFTRS)
-#define LAPACK_spftrs LAPACK_GLOBAL(spftrs,SPFTRS)
-#define LAPACK_zpftrs LAPACK_GLOBAL(zpftrs,ZPFTRS)
-#define LAPACK_cpftrs LAPACK_GLOBAL(cpftrs,CPFTRS)
-#define LAPACK_spptrs LAPACK_GLOBAL(spptrs,SPPTRS)
-#define LAPACK_dpptrs LAPACK_GLOBAL(dpptrs,DPPTRS)
-#define LAPACK_cpptrs LAPACK_GLOBAL(cpptrs,CPPTRS)
-#define LAPACK_zpptrs LAPACK_GLOBAL(zpptrs,ZPPTRS)
-#define LAPACK_spbtrs LAPACK_GLOBAL(spbtrs,SPBTRS)
-#define LAPACK_dpbtrs LAPACK_GLOBAL(dpbtrs,DPBTRS)
-#define LAPACK_cpbtrs LAPACK_GLOBAL(cpbtrs,CPBTRS)
-#define LAPACK_zpbtrs LAPACK_GLOBAL(zpbtrs,ZPBTRS)
-#define LAPACK_spttrs LAPACK_GLOBAL(spttrs,SPTTRS)
-#define LAPACK_dpttrs LAPACK_GLOBAL(dpttrs,DPTTRS)
-#define LAPACK_cpttrs LAPACK_GLOBAL(cpttrs,CPTTRS)
-#define LAPACK_zpttrs LAPACK_GLOBAL(zpttrs,ZPTTRS)
-#define LAPACK_ssytrs LAPACK_GLOBAL(ssytrs,SSYTRS)
-#define LAPACK_dsytrs LAPACK_GLOBAL(dsytrs,DSYTRS)
-#define LAPACK_csytrs LAPACK_GLOBAL(csytrs,CSYTRS)
-#define LAPACK_zsytrs LAPACK_GLOBAL(zsytrs,ZSYTRS)
-#define LAPACK_chetrs LAPACK_GLOBAL(chetrs,CHETRS)
-#define LAPACK_zhetrs LAPACK_GLOBAL(zhetrs,ZHETRS)
-#define LAPACK_ssptrs LAPACK_GLOBAL(ssptrs,SSPTRS)
-#define LAPACK_dsptrs LAPACK_GLOBAL(dsptrs,DSPTRS)
-#define LAPACK_csptrs LAPACK_GLOBAL(csptrs,CSPTRS)
-#define LAPACK_zsptrs LAPACK_GLOBAL(zsptrs,ZSPTRS)
-#define LAPACK_chptrs LAPACK_GLOBAL(chptrs,CHPTRS)
-#define LAPACK_zhptrs LAPACK_GLOBAL(zhptrs,ZHPTRS)
-#define LAPACK_strtrs LAPACK_GLOBAL(strtrs,STRTRS)
-#define LAPACK_dtrtrs LAPACK_GLOBAL(dtrtrs,DTRTRS)
-#define LAPACK_ctrtrs LAPACK_GLOBAL(ctrtrs,CTRTRS)
-#define LAPACK_ztrtrs LAPACK_GLOBAL(ztrtrs,ZTRTRS)
-#define LAPACK_stptrs LAPACK_GLOBAL(stptrs,STPTRS)
-#define LAPACK_dtptrs LAPACK_GLOBAL(dtptrs,DTPTRS)
-#define LAPACK_ctptrs LAPACK_GLOBAL(ctptrs,CTPTRS)
-#define LAPACK_ztptrs LAPACK_GLOBAL(ztptrs,ZTPTRS)
-#define LAPACK_stbtrs LAPACK_GLOBAL(stbtrs,STBTRS)
-#define LAPACK_dtbtrs LAPACK_GLOBAL(dtbtrs,DTBTRS)
-#define LAPACK_ctbtrs LAPACK_GLOBAL(ctbtrs,CTBTRS)
-#define LAPACK_ztbtrs LAPACK_GLOBAL(ztbtrs,ZTBTRS)
-#define LAPACK_sgecon LAPACK_GLOBAL(sgecon,SGECON)
-#define LAPACK_dgecon LAPACK_GLOBAL(dgecon,DGECON)
-#define LAPACK_cgecon LAPACK_GLOBAL(cgecon,CGECON)
-#define LAPACK_zgecon LAPACK_GLOBAL(zgecon,ZGECON)
-#define LAPACK_sgbcon LAPACK_GLOBAL(sgbcon,SGBCON)
-#define LAPACK_dgbcon LAPACK_GLOBAL(dgbcon,DGBCON)
-#define LAPACK_cgbcon LAPACK_GLOBAL(cgbcon,CGBCON)
-#define LAPACK_zgbcon LAPACK_GLOBAL(zgbcon,ZGBCON)
-#define LAPACK_sgtcon LAPACK_GLOBAL(sgtcon,SGTCON)
-#define LAPACK_dgtcon LAPACK_GLOBAL(dgtcon,DGTCON)
-#define LAPACK_cgtcon LAPACK_GLOBAL(cgtcon,CGTCON)
-#define LAPACK_zgtcon LAPACK_GLOBAL(zgtcon,ZGTCON)
-#define LAPACK_spocon LAPACK_GLOBAL(spocon,SPOCON)
-#define LAPACK_dpocon LAPACK_GLOBAL(dpocon,DPOCON)
-#define LAPACK_cpocon LAPACK_GLOBAL(cpocon,CPOCON)
-#define LAPACK_zpocon LAPACK_GLOBAL(zpocon,ZPOCON)
-#define LAPACK_sppcon LAPACK_GLOBAL(sppcon,SPPCON)
-#define LAPACK_dppcon LAPACK_GLOBAL(dppcon,DPPCON)
-#define LAPACK_cppcon LAPACK_GLOBAL(cppcon,CPPCON)
-#define LAPACK_zppcon LAPACK_GLOBAL(zppcon,ZPPCON)
-#define LAPACK_spbcon LAPACK_GLOBAL(spbcon,SPBCON)
-#define LAPACK_dpbcon LAPACK_GLOBAL(dpbcon,DPBCON)
-#define LAPACK_cpbcon LAPACK_GLOBAL(cpbcon,CPBCON)
-#define LAPACK_zpbcon LAPACK_GLOBAL(zpbcon,ZPBCON)
-#define LAPACK_sptcon LAPACK_GLOBAL(sptcon,SPTCON)
-#define LAPACK_dptcon LAPACK_GLOBAL(dptcon,DPTCON)
-#define LAPACK_cptcon LAPACK_GLOBAL(cptcon,CPTCON)
-#define LAPACK_zptcon LAPACK_GLOBAL(zptcon,ZPTCON)
-#define LAPACK_ssycon LAPACK_GLOBAL(ssycon,SSYCON)
-#define LAPACK_dsycon LAPACK_GLOBAL(dsycon,DSYCON)
-#define LAPACK_csycon LAPACK_GLOBAL(csycon,CSYCON)
-#define LAPACK_zsycon LAPACK_GLOBAL(zsycon,ZSYCON)
-#define LAPACK_checon LAPACK_GLOBAL(checon,CHECON)
-#define LAPACK_zhecon LAPACK_GLOBAL(zhecon,ZHECON)
-#define LAPACK_sspcon LAPACK_GLOBAL(sspcon,SSPCON)
-#define LAPACK_dspcon LAPACK_GLOBAL(dspcon,DSPCON)
-#define LAPACK_cspcon LAPACK_GLOBAL(cspcon,CSPCON)
-#define LAPACK_zspcon LAPACK_GLOBAL(zspcon,ZSPCON)
-#define LAPACK_chpcon LAPACK_GLOBAL(chpcon,CHPCON)
-#define LAPACK_zhpcon LAPACK_GLOBAL(zhpcon,ZHPCON)
-#define LAPACK_strcon LAPACK_GLOBAL(strcon,STRCON)
-#define LAPACK_dtrcon LAPACK_GLOBAL(dtrcon,DTRCON)
-#define LAPACK_ctrcon LAPACK_GLOBAL(ctrcon,CTRCON)
-#define LAPACK_ztrcon LAPACK_GLOBAL(ztrcon,ZTRCON)
-#define LAPACK_stpcon LAPACK_GLOBAL(stpcon,STPCON)
-#define LAPACK_dtpcon LAPACK_GLOBAL(dtpcon,DTPCON)
-#define LAPACK_ctpcon LAPACK_GLOBAL(ctpcon,CTPCON)
-#define LAPACK_ztpcon LAPACK_GLOBAL(ztpcon,ZTPCON)
-#define LAPACK_stbcon LAPACK_GLOBAL(stbcon,STBCON)
-#define LAPACK_dtbcon LAPACK_GLOBAL(dtbcon,DTBCON)
-#define LAPACK_ctbcon LAPACK_GLOBAL(ctbcon,CTBCON)
-#define LAPACK_ztbcon LAPACK_GLOBAL(ztbcon,ZTBCON)
-#define LAPACK_sgerfs LAPACK_GLOBAL(sgerfs,SGERFS)
-#define LAPACK_dgerfs LAPACK_GLOBAL(dgerfs,DGERFS)
-#define LAPACK_cgerfs LAPACK_GLOBAL(cgerfs,CGERFS)
-#define LAPACK_zgerfs LAPACK_GLOBAL(zgerfs,ZGERFS)
-#define LAPACK_dgerfsx LAPACK_GLOBAL(dgerfsx,DGERFSX)
-#define LAPACK_sgerfsx LAPACK_GLOBAL(sgerfsx,SGERFSX)
-#define LAPACK_zgerfsx LAPACK_GLOBAL(zgerfsx,ZGERFSX)
-#define LAPACK_cgerfsx LAPACK_GLOBAL(cgerfsx,CGERFSX)
-#define LAPACK_sgbrfs LAPACK_GLOBAL(sgbrfs,SGBRFS)
-#define LAPACK_dgbrfs LAPACK_GLOBAL(dgbrfs,DGBRFS)
-#define LAPACK_cgbrfs LAPACK_GLOBAL(cgbrfs,CGBRFS)
-#define LAPACK_zgbrfs LAPACK_GLOBAL(zgbrfs,ZGBRFS)
-#define LAPACK_dgbrfsx LAPACK_GLOBAL(dgbrfsx,DGBRFSX)
-#define LAPACK_sgbrfsx LAPACK_GLOBAL(sgbrfsx,SGBRFSX)
-#define LAPACK_zgbrfsx LAPACK_GLOBAL(zgbrfsx,ZGBRFSX)
-#define LAPACK_cgbrfsx LAPACK_GLOBAL(cgbrfsx,CGBRFSX)
-#define LAPACK_sgtrfs LAPACK_GLOBAL(sgtrfs,SGTRFS)
-#define LAPACK_dgtrfs LAPACK_GLOBAL(dgtrfs,DGTRFS)
-#define LAPACK_cgtrfs LAPACK_GLOBAL(cgtrfs,CGTRFS)
-#define LAPACK_zgtrfs LAPACK_GLOBAL(zgtrfs,ZGTRFS)
-#define LAPACK_sporfs LAPACK_GLOBAL(sporfs,SPORFS)
-#define LAPACK_dporfs LAPACK_GLOBAL(dporfs,DPORFS)
-#define LAPACK_cporfs LAPACK_GLOBAL(cporfs,CPORFS)
-#define LAPACK_zporfs LAPACK_GLOBAL(zporfs,ZPORFS)
-#define LAPACK_dporfsx LAPACK_GLOBAL(dporfsx,DPORFSX)
-#define LAPACK_sporfsx LAPACK_GLOBAL(sporfsx,SPORFSX)
-#define LAPACK_zporfsx LAPACK_GLOBAL(zporfsx,ZPORFSX)
-#define LAPACK_cporfsx LAPACK_GLOBAL(cporfsx,CPORFSX)
-#define LAPACK_spprfs LAPACK_GLOBAL(spprfs,SPPRFS)
-#define LAPACK_dpprfs LAPACK_GLOBAL(dpprfs,DPPRFS)
-#define LAPACK_cpprfs LAPACK_GLOBAL(cpprfs,CPPRFS)
-#define LAPACK_zpprfs LAPACK_GLOBAL(zpprfs,ZPPRFS)
-#define LAPACK_spbrfs LAPACK_GLOBAL(spbrfs,SPBRFS)
-#define LAPACK_dpbrfs LAPACK_GLOBAL(dpbrfs,DPBRFS)
-#define LAPACK_cpbrfs LAPACK_GLOBAL(cpbrfs,CPBRFS)
-#define LAPACK_zpbrfs LAPACK_GLOBAL(zpbrfs,ZPBRFS)
-#define LAPACK_sptrfs LAPACK_GLOBAL(sptrfs,SPTRFS)
-#define LAPACK_dptrfs LAPACK_GLOBAL(dptrfs,DPTRFS)
-#define LAPACK_cptrfs LAPACK_GLOBAL(cptrfs,CPTRFS)
-#define LAPACK_zptrfs LAPACK_GLOBAL(zptrfs,ZPTRFS)
-#define LAPACK_ssyrfs LAPACK_GLOBAL(ssyrfs,SSYRFS)
-#define LAPACK_dsyrfs LAPACK_GLOBAL(dsyrfs,DSYRFS)
-#define LAPACK_csyrfs LAPACK_GLOBAL(csyrfs,CSYRFS)
-#define LAPACK_zsyrfs LAPACK_GLOBAL(zsyrfs,ZSYRFS)
-#define LAPACK_dsyrfsx LAPACK_GLOBAL(dsyrfsx,DSYRFSX)
-#define LAPACK_ssyrfsx LAPACK_GLOBAL(ssyrfsx,SSYRFSX)
-#define LAPACK_zsyrfsx LAPACK_GLOBAL(zsyrfsx,ZSYRFSX)
-#define LAPACK_csyrfsx LAPACK_GLOBAL(csyrfsx,CSYRFSX)
-#define LAPACK_cherfs LAPACK_GLOBAL(cherfs,CHERFS)
-#define LAPACK_zherfs LAPACK_GLOBAL(zherfs,ZHERFS)
-#define LAPACK_zherfsx LAPACK_GLOBAL(zherfsx,ZHERFSX)
-#define LAPACK_cherfsx LAPACK_GLOBAL(cherfsx,CHERFSX)
-#define LAPACK_ssprfs LAPACK_GLOBAL(ssprfs,SSPRFS)
-#define LAPACK_dsprfs LAPACK_GLOBAL(dsprfs,DSPRFS)
-#define LAPACK_csprfs LAPACK_GLOBAL(csprfs,CSPRFS)
-#define LAPACK_zsprfs LAPACK_GLOBAL(zsprfs,ZSPRFS)
-#define LAPACK_chprfs LAPACK_GLOBAL(chprfs,CHPRFS)
-#define LAPACK_zhprfs LAPACK_GLOBAL(zhprfs,ZHPRFS)
-#define LAPACK_strrfs LAPACK_GLOBAL(strrfs,STRRFS)
-#define LAPACK_dtrrfs LAPACK_GLOBAL(dtrrfs,DTRRFS)
-#define LAPACK_ctrrfs LAPACK_GLOBAL(ctrrfs,CTRRFS)
-#define LAPACK_ztrrfs LAPACK_GLOBAL(ztrrfs,ZTRRFS)
-#define LAPACK_stprfs LAPACK_GLOBAL(stprfs,STPRFS)
-#define LAPACK_dtprfs LAPACK_GLOBAL(dtprfs,DTPRFS)
-#define LAPACK_ctprfs LAPACK_GLOBAL(ctprfs,CTPRFS)
-#define LAPACK_ztprfs LAPACK_GLOBAL(ztprfs,ZTPRFS)
-#define LAPACK_stbrfs LAPACK_GLOBAL(stbrfs,STBRFS)
-#define LAPACK_dtbrfs LAPACK_GLOBAL(dtbrfs,DTBRFS)
-#define LAPACK_ctbrfs LAPACK_GLOBAL(ctbrfs,CTBRFS)
-#define LAPACK_ztbrfs LAPACK_GLOBAL(ztbrfs,ZTBRFS)
-#define LAPACK_sgetri LAPACK_GLOBAL(sgetri,SGETRI)
-#define LAPACK_dgetri LAPACK_GLOBAL(dgetri,DGETRI)
-#define LAPACK_cgetri LAPACK_GLOBAL(cgetri,CGETRI)
-#define LAPACK_zgetri LAPACK_GLOBAL(zgetri,ZGETRI)
-#define LAPACK_spotri LAPACK_GLOBAL(spotri,SPOTRI)
-#define LAPACK_dpotri LAPACK_GLOBAL(dpotri,DPOTRI)
-#define LAPACK_cpotri LAPACK_GLOBAL(cpotri,CPOTRI)
-#define LAPACK_zpotri LAPACK_GLOBAL(zpotri,ZPOTRI)
-#define LAPACK_dpftri LAPACK_GLOBAL(dpftri,DPFTRI)
-#define LAPACK_spftri LAPACK_GLOBAL(spftri,SPFTRI)
-#define LAPACK_zpftri LAPACK_GLOBAL(zpftri,ZPFTRI)
-#define LAPACK_cpftri LAPACK_GLOBAL(cpftri,CPFTRI)
-#define LAPACK_spptri LAPACK_GLOBAL(spptri,SPPTRI)
-#define LAPACK_dpptri LAPACK_GLOBAL(dpptri,DPPTRI)
-#define LAPACK_cpptri LAPACK_GLOBAL(cpptri,CPPTRI)
-#define LAPACK_zpptri LAPACK_GLOBAL(zpptri,ZPPTRI)
-#define LAPACK_ssytri LAPACK_GLOBAL(ssytri,SSYTRI)
-#define LAPACK_dsytri LAPACK_GLOBAL(dsytri,DSYTRI)
-#define LAPACK_csytri LAPACK_GLOBAL(csytri,CSYTRI)
-#define LAPACK_zsytri LAPACK_GLOBAL(zsytri,ZSYTRI)
-#define LAPACK_chetri LAPACK_GLOBAL(chetri,CHETRI)
-#define LAPACK_zhetri LAPACK_GLOBAL(zhetri,ZHETRI)
-#define LAPACK_ssptri LAPACK_GLOBAL(ssptri,SSPTRI)
-#define LAPACK_dsptri LAPACK_GLOBAL(dsptri,DSPTRI)
-#define LAPACK_csptri LAPACK_GLOBAL(csptri,CSPTRI)
-#define LAPACK_zsptri LAPACK_GLOBAL(zsptri,ZSPTRI)
-#define LAPACK_chptri LAPACK_GLOBAL(chptri,CHPTRI)
-#define LAPACK_zhptri LAPACK_GLOBAL(zhptri,ZHPTRI)
-#define LAPACK_strtri LAPACK_GLOBAL(strtri,STRTRI)
-#define LAPACK_dtrtri LAPACK_GLOBAL(dtrtri,DTRTRI)
-#define LAPACK_ctrtri LAPACK_GLOBAL(ctrtri,CTRTRI)
-#define LAPACK_ztrtri LAPACK_GLOBAL(ztrtri,ZTRTRI)
-#define LAPACK_dtftri LAPACK_GLOBAL(dtftri,DTFTRI)
-#define LAPACK_stftri LAPACK_GLOBAL(stftri,STFTRI)
-#define LAPACK_ztftri LAPACK_GLOBAL(ztftri,ZTFTRI)
-#define LAPACK_ctftri LAPACK_GLOBAL(ctftri,CTFTRI)
-#define LAPACK_stptri LAPACK_GLOBAL(stptri,STPTRI)
-#define LAPACK_dtptri LAPACK_GLOBAL(dtptri,DTPTRI)
-#define LAPACK_ctptri LAPACK_GLOBAL(ctptri,CTPTRI)
-#define LAPACK_ztptri LAPACK_GLOBAL(ztptri,ZTPTRI)
-#define LAPACK_sgeequ LAPACK_GLOBAL(sgeequ,SGEEQU)
-#define LAPACK_dgeequ LAPACK_GLOBAL(dgeequ,DGEEQU)
-#define LAPACK_cgeequ LAPACK_GLOBAL(cgeequ,CGEEQU)
-#define LAPACK_zgeequ LAPACK_GLOBAL(zgeequ,ZGEEQU)
-#define LAPACK_dgeequb LAPACK_GLOBAL(dgeequb,DGEEQUB)
-#define LAPACK_sgeequb LAPACK_GLOBAL(sgeequb,SGEEQUB)
-#define LAPACK_zgeequb LAPACK_GLOBAL(zgeequb,ZGEEQUB)
-#define LAPACK_cgeequb LAPACK_GLOBAL(cgeequb,CGEEQUB)
-#define LAPACK_sgbequ LAPACK_GLOBAL(sgbequ,SGBEQU)
-#define LAPACK_dgbequ LAPACK_GLOBAL(dgbequ,DGBEQU)
-#define LAPACK_cgbequ LAPACK_GLOBAL(cgbequ,CGBEQU)
-#define LAPACK_zgbequ LAPACK_GLOBAL(zgbequ,ZGBEQU)
-#define LAPACK_dgbequb LAPACK_GLOBAL(dgbequb,DGBEQUB)
-#define LAPACK_sgbequb LAPACK_GLOBAL(sgbequb,SGBEQUB)
-#define LAPACK_zgbequb LAPACK_GLOBAL(zgbequb,ZGBEQUB)
-#define LAPACK_cgbequb LAPACK_GLOBAL(cgbequb,CGBEQUB)
-#define LAPACK_spoequ LAPACK_GLOBAL(spoequ,SPOEQU)
-#define LAPACK_dpoequ LAPACK_GLOBAL(dpoequ,DPOEQU)
-#define LAPACK_cpoequ LAPACK_GLOBAL(cpoequ,CPOEQU)
-#define LAPACK_zpoequ LAPACK_GLOBAL(zpoequ,ZPOEQU)
-#define LAPACK_dpoequb LAPACK_GLOBAL(dpoequb,DPOEQUB)
-#define LAPACK_spoequb LAPACK_GLOBAL(spoequb,SPOEQUB)
-#define LAPACK_zpoequb LAPACK_GLOBAL(zpoequb,ZPOEQUB)
-#define LAPACK_cpoequb LAPACK_GLOBAL(cpoequb,CPOEQUB)
-#define LAPACK_sppequ LAPACK_GLOBAL(sppequ,SPPEQU)
-#define LAPACK_dppequ LAPACK_GLOBAL(dppequ,DPPEQU)
-#define LAPACK_cppequ LAPACK_GLOBAL(cppequ,CPPEQU)
-#define LAPACK_zppequ LAPACK_GLOBAL(zppequ,ZPPEQU)
-#define LAPACK_spbequ LAPACK_GLOBAL(spbequ,SPBEQU)
-#define LAPACK_dpbequ LAPACK_GLOBAL(dpbequ,DPBEQU)
-#define LAPACK_cpbequ LAPACK_GLOBAL(cpbequ,CPBEQU)
-#define LAPACK_zpbequ LAPACK_GLOBAL(zpbequ,ZPBEQU)
-#define LAPACK_dsyequb LAPACK_GLOBAL(dsyequb,DSYEQUB)
-#define LAPACK_ssyequb LAPACK_GLOBAL(ssyequb,SSYEQUB)
-#define LAPACK_zsyequb LAPACK_GLOBAL(zsyequb,ZSYEQUB)
-#define LAPACK_csyequb LAPACK_GLOBAL(csyequb,CSYEQUB)
-#define LAPACK_zheequb LAPACK_GLOBAL(zheequb,ZHEEQUB)
-#define LAPACK_cheequb LAPACK_GLOBAL(cheequb,CHEEQUB)
-#define LAPACK_sgesv LAPACK_GLOBAL(sgesv,SGESV)
-#define LAPACK_dgesv LAPACK_GLOBAL(dgesv,DGESV)
-#define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV)
-#define LAPACK_zgesv LAPACK_GLOBAL(zgesv,ZGESV)
-#define LAPACK_dsgesv LAPACK_GLOBAL(dsgesv,DSGESV)
-#define LAPACK_zcgesv LAPACK_GLOBAL(zcgesv,ZCGESV)
-#define LAPACK_sgesvx LAPACK_GLOBAL(sgesvx,SGESVX)
-#define LAPACK_dgesvx LAPACK_GLOBAL(dgesvx,DGESVX)
-#define LAPACK_cgesvx LAPACK_GLOBAL(cgesvx,CGESVX)
-#define LAPACK_zgesvx LAPACK_GLOBAL(zgesvx,ZGESVX)
-#define LAPACK_dgesvxx LAPACK_GLOBAL(dgesvxx,DGESVXX)
-#define LAPACK_sgesvxx LAPACK_GLOBAL(sgesvxx,SGESVXX)
-#define LAPACK_zgesvxx LAPACK_GLOBAL(zgesvxx,ZGESVXX)
-#define LAPACK_cgesvxx LAPACK_GLOBAL(cgesvxx,CGESVXX)
-#define LAPACK_sgbsv LAPACK_GLOBAL(sgbsv,SGBSV)
-#define LAPACK_dgbsv LAPACK_GLOBAL(dgbsv,DGBSV)
-#define LAPACK_cgbsv LAPACK_GLOBAL(cgbsv,CGBSV)
-#define LAPACK_zgbsv LAPACK_GLOBAL(zgbsv,ZGBSV)
-#define LAPACK_sgbsvx LAPACK_GLOBAL(sgbsvx,SGBSVX)
-#define LAPACK_dgbsvx LAPACK_GLOBAL(dgbsvx,DGBSVX)
-#define LAPACK_cgbsvx LAPACK_GLOBAL(cgbsvx,CGBSVX)
-#define LAPACK_zgbsvx LAPACK_GLOBAL(zgbsvx,ZGBSVX)
-#define LAPACK_dgbsvxx LAPACK_GLOBAL(dgbsvxx,DGBSVXX)
-#define LAPACK_sgbsvxx LAPACK_GLOBAL(sgbsvxx,SGBSVXX)
-#define LAPACK_zgbsvxx LAPACK_GLOBAL(zgbsvxx,ZGBSVXX)
-#define LAPACK_cgbsvxx LAPACK_GLOBAL(cgbsvxx,CGBSVXX)
-#define LAPACK_sgtsv LAPACK_GLOBAL(sgtsv,SGTSV)
-#define LAPACK_dgtsv LAPACK_GLOBAL(dgtsv,DGTSV)
-#define LAPACK_cgtsv LAPACK_GLOBAL(cgtsv,CGTSV)
-#define LAPACK_zgtsv LAPACK_GLOBAL(zgtsv,ZGTSV)
-#define LAPACK_sgtsvx LAPACK_GLOBAL(sgtsvx,SGTSVX)
-#define LAPACK_dgtsvx LAPACK_GLOBAL(dgtsvx,DGTSVX)
-#define LAPACK_cgtsvx LAPACK_GLOBAL(cgtsvx,CGTSVX)
-#define LAPACK_zgtsvx LAPACK_GLOBAL(zgtsvx,ZGTSVX)
-#define LAPACK_sposv LAPACK_GLOBAL(sposv,SPOSV)
-#define LAPACK_dposv LAPACK_GLOBAL(dposv,DPOSV)
-#define LAPACK_cposv LAPACK_GLOBAL(cposv,CPOSV)
-#define LAPACK_zposv LAPACK_GLOBAL(zposv,ZPOSV)
-#define LAPACK_dsposv LAPACK_GLOBAL(dsposv,DSPOSV)
-#define LAPACK_zcposv LAPACK_GLOBAL(zcposv,ZCPOSV)
-#define LAPACK_sposvx LAPACK_GLOBAL(sposvx,SPOSVX)
-#define LAPACK_dposvx LAPACK_GLOBAL(dposvx,DPOSVX)
-#define LAPACK_cposvx LAPACK_GLOBAL(cposvx,CPOSVX)
-#define LAPACK_zposvx LAPACK_GLOBAL(zposvx,ZPOSVX)
-#define LAPACK_dposvxx LAPACK_GLOBAL(dposvxx,DPOSVXX)
-#define LAPACK_sposvxx LAPACK_GLOBAL(sposvxx,SPOSVXX)
-#define LAPACK_zposvxx LAPACK_GLOBAL(zposvxx,ZPOSVXX)
-#define LAPACK_cposvxx LAPACK_GLOBAL(cposvxx,CPOSVXX)
-#define LAPACK_sppsv LAPACK_GLOBAL(sppsv,SPPSV)
-#define LAPACK_dppsv LAPACK_GLOBAL(dppsv,DPPSV)
-#define LAPACK_cppsv LAPACK_GLOBAL(cppsv,CPPSV)
-#define LAPACK_zppsv LAPACK_GLOBAL(zppsv,ZPPSV)
-#define LAPACK_sppsvx LAPACK_GLOBAL(sppsvx,SPPSVX)
-#define LAPACK_dppsvx LAPACK_GLOBAL(dppsvx,DPPSVX)
-#define LAPACK_cppsvx LAPACK_GLOBAL(cppsvx,CPPSVX)
-#define LAPACK_zppsvx LAPACK_GLOBAL(zppsvx,ZPPSVX)
-#define LAPACK_spbsv LAPACK_GLOBAL(spbsv,SPBSV)
-#define LAPACK_dpbsv LAPACK_GLOBAL(dpbsv,DPBSV)
-#define LAPACK_cpbsv LAPACK_GLOBAL(cpbsv,CPBSV)
-#define LAPACK_zpbsv LAPACK_GLOBAL(zpbsv,ZPBSV)
-#define LAPACK_spbsvx LAPACK_GLOBAL(spbsvx,SPBSVX)
-#define LAPACK_dpbsvx LAPACK_GLOBAL(dpbsvx,DPBSVX)
-#define LAPACK_cpbsvx LAPACK_GLOBAL(cpbsvx,CPBSVX)
-#define LAPACK_zpbsvx LAPACK_GLOBAL(zpbsvx,ZPBSVX)
-#define LAPACK_sptsv LAPACK_GLOBAL(sptsv,SPTSV)
-#define LAPACK_dptsv LAPACK_GLOBAL(dptsv,DPTSV)
-#define LAPACK_cptsv LAPACK_GLOBAL(cptsv,CPTSV)
-#define LAPACK_zptsv LAPACK_GLOBAL(zptsv,ZPTSV)
-#define LAPACK_sptsvx LAPACK_GLOBAL(sptsvx,SPTSVX)
-#define LAPACK_dptsvx LAPACK_GLOBAL(dptsvx,DPTSVX)
-#define LAPACK_cptsvx LAPACK_GLOBAL(cptsvx,CPTSVX)
-#define LAPACK_zptsvx LAPACK_GLOBAL(zptsvx,ZPTSVX)
-#define LAPACK_ssysv LAPACK_GLOBAL(ssysv,SSYSV)
-#define LAPACK_dsysv LAPACK_GLOBAL(dsysv,DSYSV)
-#define LAPACK_csysv LAPACK_GLOBAL(csysv,CSYSV)
-#define LAPACK_zsysv LAPACK_GLOBAL(zsysv,ZSYSV)
-#define LAPACK_ssysvx LAPACK_GLOBAL(ssysvx,SSYSVX)
-#define LAPACK_dsysvx LAPACK_GLOBAL(dsysvx,DSYSVX)
-#define LAPACK_csysvx LAPACK_GLOBAL(csysvx,CSYSVX)
-#define LAPACK_zsysvx LAPACK_GLOBAL(zsysvx,ZSYSVX)
-#define LAPACK_dsysvxx LAPACK_GLOBAL(dsysvxx,DSYSVXX)
-#define LAPACK_ssysvxx LAPACK_GLOBAL(ssysvxx,SSYSVXX)
-#define LAPACK_zsysvxx LAPACK_GLOBAL(zsysvxx,ZSYSVXX)
-#define LAPACK_csysvxx LAPACK_GLOBAL(csysvxx,CSYSVXX)
-#define LAPACK_chesv LAPACK_GLOBAL(chesv,CHESV)
-#define LAPACK_zhesv LAPACK_GLOBAL(zhesv,ZHESV)
-#define LAPACK_chesvx LAPACK_GLOBAL(chesvx,CHESVX)
-#define LAPACK_zhesvx LAPACK_GLOBAL(zhesvx,ZHESVX)
-#define LAPACK_zhesvxx LAPACK_GLOBAL(zhesvxx,ZHESVXX)
-#define LAPACK_chesvxx LAPACK_GLOBAL(chesvxx,CHESVXX)
-#define LAPACK_sspsv LAPACK_GLOBAL(sspsv,SSPSV)
-#define LAPACK_dspsv LAPACK_GLOBAL(dspsv,DSPSV)
-#define LAPACK_cspsv LAPACK_GLOBAL(cspsv,CSPSV)
-#define LAPACK_zspsv LAPACK_GLOBAL(zspsv,ZSPSV)
-#define LAPACK_sspsvx LAPACK_GLOBAL(sspsvx,SSPSVX)
-#define LAPACK_dspsvx LAPACK_GLOBAL(dspsvx,DSPSVX)
-#define LAPACK_cspsvx LAPACK_GLOBAL(cspsvx,CSPSVX)
-#define LAPACK_zspsvx LAPACK_GLOBAL(zspsvx,ZSPSVX)
-#define LAPACK_chpsv LAPACK_GLOBAL(chpsv,CHPSV)
-#define LAPACK_zhpsv LAPACK_GLOBAL(zhpsv,ZHPSV)
-#define LAPACK_chpsvx LAPACK_GLOBAL(chpsvx,CHPSVX)
-#define LAPACK_zhpsvx LAPACK_GLOBAL(zhpsvx,ZHPSVX)
-#define LAPACK_sgeqrf LAPACK_GLOBAL(sgeqrf,SGEQRF)
-#define LAPACK_dgeqrf LAPACK_GLOBAL(dgeqrf,DGEQRF)
-#define LAPACK_cgeqrf LAPACK_GLOBAL(cgeqrf,CGEQRF)
-#define LAPACK_zgeqrf LAPACK_GLOBAL(zgeqrf,ZGEQRF)
-#define LAPACK_sgeqpf LAPACK_GLOBAL(sgeqpf,SGEQPF)
-#define LAPACK_dgeqpf LAPACK_GLOBAL(dgeqpf,DGEQPF)
-#define LAPACK_cgeqpf LAPACK_GLOBAL(cgeqpf,CGEQPF)
-#define LAPACK_zgeqpf LAPACK_GLOBAL(zgeqpf,ZGEQPF)
-#define LAPACK_sgeqp3 LAPACK_GLOBAL(sgeqp3,SGEQP3)
-#define LAPACK_dgeqp3 LAPACK_GLOBAL(dgeqp3,DGEQP3)
-#define LAPACK_cgeqp3 LAPACK_GLOBAL(cgeqp3,CGEQP3)
-#define LAPACK_zgeqp3 LAPACK_GLOBAL(zgeqp3,ZGEQP3)
-#define LAPACK_sorgqr LAPACK_GLOBAL(sorgqr,SORGQR)
-#define LAPACK_dorgqr LAPACK_GLOBAL(dorgqr,DORGQR)
-#define LAPACK_sormqr LAPACK_GLOBAL(sormqr,SORMQR)
-#define LAPACK_dormqr LAPACK_GLOBAL(dormqr,DORMQR)
-#define LAPACK_cungqr LAPACK_GLOBAL(cungqr,CUNGQR)
-#define LAPACK_zungqr LAPACK_GLOBAL(zungqr,ZUNGQR)
-#define LAPACK_cunmqr LAPACK_GLOBAL(cunmqr,CUNMQR)
-#define LAPACK_zunmqr LAPACK_GLOBAL(zunmqr,ZUNMQR)
-#define LAPACK_sgelqf LAPACK_GLOBAL(sgelqf,SGELQF)
-#define LAPACK_dgelqf LAPACK_GLOBAL(dgelqf,DGELQF)
-#define LAPACK_cgelqf LAPACK_GLOBAL(cgelqf,CGELQF)
-#define LAPACK_zgelqf LAPACK_GLOBAL(zgelqf,ZGELQF)
-#define LAPACK_sorglq LAPACK_GLOBAL(sorglq,SORGLQ)
-#define LAPACK_dorglq LAPACK_GLOBAL(dorglq,DORGLQ)
-#define LAPACK_sormlq LAPACK_GLOBAL(sormlq,SORMLQ)
-#define LAPACK_dormlq LAPACK_GLOBAL(dormlq,DORMLQ)
-#define LAPACK_cunglq LAPACK_GLOBAL(cunglq,CUNGLQ)
-#define LAPACK_zunglq LAPACK_GLOBAL(zunglq,ZUNGLQ)
-#define LAPACK_cunmlq LAPACK_GLOBAL(cunmlq,CUNMLQ)
-#define LAPACK_zunmlq LAPACK_GLOBAL(zunmlq,ZUNMLQ)
-#define LAPACK_sgeqlf LAPACK_GLOBAL(sgeqlf,SGEQLF)
-#define LAPACK_dgeqlf LAPACK_GLOBAL(dgeqlf,DGEQLF)
-#define LAPACK_cgeqlf LAPACK_GLOBAL(cgeqlf,CGEQLF)
-#define LAPACK_zgeqlf LAPACK_GLOBAL(zgeqlf,ZGEQLF)
-#define LAPACK_sorgql LAPACK_GLOBAL(sorgql,SORGQL)
-#define LAPACK_dorgql LAPACK_GLOBAL(dorgql,DORGQL)
-#define LAPACK_cungql LAPACK_GLOBAL(cungql,CUNGQL)
-#define LAPACK_zungql LAPACK_GLOBAL(zungql,ZUNGQL)
-#define LAPACK_sormql LAPACK_GLOBAL(sormql,SORMQL)
-#define LAPACK_dormql LAPACK_GLOBAL(dormql,DORMQL)
-#define LAPACK_cunmql LAPACK_GLOBAL(cunmql,CUNMQL)
-#define LAPACK_zunmql LAPACK_GLOBAL(zunmql,ZUNMQL)
-#define LAPACK_sgerqf LAPACK_GLOBAL(sgerqf,SGERQF)
-#define LAPACK_dgerqf LAPACK_GLOBAL(dgerqf,DGERQF)
-#define LAPACK_cgerqf LAPACK_GLOBAL(cgerqf,CGERQF)
-#define LAPACK_zgerqf LAPACK_GLOBAL(zgerqf,ZGERQF)
-#define LAPACK_sorgrq LAPACK_GLOBAL(sorgrq,SORGRQ)
-#define LAPACK_dorgrq LAPACK_GLOBAL(dorgrq,DORGRQ)
-#define LAPACK_cungrq LAPACK_GLOBAL(cungrq,CUNGRQ)
-#define LAPACK_zungrq LAPACK_GLOBAL(zungrq,ZUNGRQ)
-#define LAPACK_sormrq LAPACK_GLOBAL(sormrq,SORMRQ)
-#define LAPACK_dormrq LAPACK_GLOBAL(dormrq,DORMRQ)
-#define LAPACK_cunmrq LAPACK_GLOBAL(cunmrq,CUNMRQ)
-#define LAPACK_zunmrq LAPACK_GLOBAL(zunmrq,ZUNMRQ)
-#define LAPACK_stzrzf LAPACK_GLOBAL(stzrzf,STZRZF)
-#define LAPACK_dtzrzf LAPACK_GLOBAL(dtzrzf,DTZRZF)
-#define LAPACK_ctzrzf LAPACK_GLOBAL(ctzrzf,CTZRZF)
-#define LAPACK_ztzrzf LAPACK_GLOBAL(ztzrzf,ZTZRZF)
-#define LAPACK_sormrz LAPACK_GLOBAL(sormrz,SORMRZ)
-#define LAPACK_dormrz LAPACK_GLOBAL(dormrz,DORMRZ)
-#define LAPACK_cunmrz LAPACK_GLOBAL(cunmrz,CUNMRZ)
-#define LAPACK_zunmrz LAPACK_GLOBAL(zunmrz,ZUNMRZ)
-#define LAPACK_sggqrf LAPACK_GLOBAL(sggqrf,SGGQRF)
-#define LAPACK_dggqrf LAPACK_GLOBAL(dggqrf,DGGQRF)
-#define LAPACK_cggqrf LAPACK_GLOBAL(cggqrf,CGGQRF)
-#define LAPACK_zggqrf LAPACK_GLOBAL(zggqrf,ZGGQRF)
-#define LAPACK_sggrqf LAPACK_GLOBAL(sggrqf,SGGRQF)
-#define LAPACK_dggrqf LAPACK_GLOBAL(dggrqf,DGGRQF)
-#define LAPACK_cggrqf LAPACK_GLOBAL(cggrqf,CGGRQF)
-#define LAPACK_zggrqf LAPACK_GLOBAL(zggrqf,ZGGRQF)
-#define LAPACK_sgebrd LAPACK_GLOBAL(sgebrd,SGEBRD)
-#define LAPACK_dgebrd LAPACK_GLOBAL(dgebrd,DGEBRD)
-#define LAPACK_cgebrd LAPACK_GLOBAL(cgebrd,CGEBRD)
-#define LAPACK_zgebrd LAPACK_GLOBAL(zgebrd,ZGEBRD)
-#define LAPACK_sgbbrd LAPACK_GLOBAL(sgbbrd,SGBBRD)
-#define LAPACK_dgbbrd LAPACK_GLOBAL(dgbbrd,DGBBRD)
-#define LAPACK_cgbbrd LAPACK_GLOBAL(cgbbrd,CGBBRD)
-#define LAPACK_zgbbrd LAPACK_GLOBAL(zgbbrd,ZGBBRD)
-#define LAPACK_sorgbr LAPACK_GLOBAL(sorgbr,SORGBR)
-#define LAPACK_dorgbr LAPACK_GLOBAL(dorgbr,DORGBR)
-#define LAPACK_sormbr LAPACK_GLOBAL(sormbr,SORMBR)
-#define LAPACK_dormbr LAPACK_GLOBAL(dormbr,DORMBR)
-#define LAPACK_cungbr LAPACK_GLOBAL(cungbr,CUNGBR)
-#define LAPACK_zungbr LAPACK_GLOBAL(zungbr,ZUNGBR)
-#define LAPACK_cunmbr LAPACK_GLOBAL(cunmbr,CUNMBR)
-#define LAPACK_zunmbr LAPACK_GLOBAL(zunmbr,ZUNMBR)
-#define LAPACK_sbdsqr LAPACK_GLOBAL(sbdsqr,SBDSQR)
-#define LAPACK_dbdsqr LAPACK_GLOBAL(dbdsqr,DBDSQR)
-#define LAPACK_cbdsqr LAPACK_GLOBAL(cbdsqr,CBDSQR)
-#define LAPACK_zbdsqr LAPACK_GLOBAL(zbdsqr,ZBDSQR)
-#define LAPACK_sbdsdc LAPACK_GLOBAL(sbdsdc,SBDSDC)
-#define LAPACK_dbdsdc LAPACK_GLOBAL(dbdsdc,DBDSDC)
-#define LAPACK_ssytrd LAPACK_GLOBAL(ssytrd,SSYTRD)
-#define LAPACK_dsytrd LAPACK_GLOBAL(dsytrd,DSYTRD)
-#define LAPACK_sorgtr LAPACK_GLOBAL(sorgtr,SORGTR)
-#define LAPACK_dorgtr LAPACK_GLOBAL(dorgtr,DORGTR)
-#define LAPACK_sormtr LAPACK_GLOBAL(sormtr,SORMTR)
-#define LAPACK_dormtr LAPACK_GLOBAL(dormtr,DORMTR)
-#define LAPACK_chetrd LAPACK_GLOBAL(chetrd,CHETRD)
-#define LAPACK_zhetrd LAPACK_GLOBAL(zhetrd,ZHETRD)
-#define LAPACK_cungtr LAPACK_GLOBAL(cungtr,CUNGTR)
-#define LAPACK_zungtr LAPACK_GLOBAL(zungtr,ZUNGTR)
-#define LAPACK_cunmtr LAPACK_GLOBAL(cunmtr,CUNMTR)
-#define LAPACK_zunmtr LAPACK_GLOBAL(zunmtr,ZUNMTR)
-#define LAPACK_ssptrd LAPACK_GLOBAL(ssptrd,SSPTRD)
-#define LAPACK_dsptrd LAPACK_GLOBAL(dsptrd,DSPTRD)
-#define LAPACK_sopgtr LAPACK_GLOBAL(sopgtr,SOPGTR)
-#define LAPACK_dopgtr LAPACK_GLOBAL(dopgtr,DOPGTR)
-#define LAPACK_sopmtr LAPACK_GLOBAL(sopmtr,SOPMTR)
-#define LAPACK_dopmtr LAPACK_GLOBAL(dopmtr,DOPMTR)
-#define LAPACK_chptrd LAPACK_GLOBAL(chptrd,CHPTRD)
-#define LAPACK_zhptrd LAPACK_GLOBAL(zhptrd,ZHPTRD)
-#define LAPACK_cupgtr LAPACK_GLOBAL(cupgtr,CUPGTR)
-#define LAPACK_zupgtr LAPACK_GLOBAL(zupgtr,ZUPGTR)
-#define LAPACK_cupmtr LAPACK_GLOBAL(cupmtr,CUPMTR)
-#define LAPACK_zupmtr LAPACK_GLOBAL(zupmtr,ZUPMTR)
-#define LAPACK_ssbtrd LAPACK_GLOBAL(ssbtrd,SSBTRD)
-#define LAPACK_dsbtrd LAPACK_GLOBAL(dsbtrd,DSBTRD)
-#define LAPACK_chbtrd LAPACK_GLOBAL(chbtrd,CHBTRD)
-#define LAPACK_zhbtrd LAPACK_GLOBAL(zhbtrd,ZHBTRD)
-#define LAPACK_ssterf LAPACK_GLOBAL(ssterf,SSTERF)
-#define LAPACK_dsterf LAPACK_GLOBAL(dsterf,DSTERF)
-#define LAPACK_ssteqr LAPACK_GLOBAL(ssteqr,SSTEQR)
-#define LAPACK_dsteqr LAPACK_GLOBAL(dsteqr,DSTEQR)
-#define LAPACK_csteqr LAPACK_GLOBAL(csteqr,CSTEQR)
-#define LAPACK_zsteqr LAPACK_GLOBAL(zsteqr,ZSTEQR)
-#define LAPACK_sstemr LAPACK_GLOBAL(sstemr,SSTEMR)
-#define LAPACK_dstemr LAPACK_GLOBAL(dstemr,DSTEMR)
-#define LAPACK_cstemr LAPACK_GLOBAL(cstemr,CSTEMR)
-#define LAPACK_zstemr LAPACK_GLOBAL(zstemr,ZSTEMR)
-#define LAPACK_sstedc LAPACK_GLOBAL(sstedc,SSTEDC)
-#define LAPACK_dstedc LAPACK_GLOBAL(dstedc,DSTEDC)
-#define LAPACK_cstedc LAPACK_GLOBAL(cstedc,CSTEDC)
-#define LAPACK_zstedc LAPACK_GLOBAL(zstedc,ZSTEDC)
-#define LAPACK_sstegr LAPACK_GLOBAL(sstegr,SSTEGR)
-#define LAPACK_dstegr LAPACK_GLOBAL(dstegr,DSTEGR)
-#define LAPACK_cstegr LAPACK_GLOBAL(cstegr,CSTEGR)
-#define LAPACK_zstegr LAPACK_GLOBAL(zstegr,ZSTEGR)
-#define LAPACK_spteqr LAPACK_GLOBAL(spteqr,SPTEQR)
-#define LAPACK_dpteqr LAPACK_GLOBAL(dpteqr,DPTEQR)
-#define LAPACK_cpteqr LAPACK_GLOBAL(cpteqr,CPTEQR)
-#define LAPACK_zpteqr LAPACK_GLOBAL(zpteqr,ZPTEQR)
-#define LAPACK_sstebz LAPACK_GLOBAL(sstebz,SSTEBZ)
-#define LAPACK_dstebz LAPACK_GLOBAL(dstebz,DSTEBZ)
-#define LAPACK_sstein LAPACK_GLOBAL(sstein,SSTEIN)
-#define LAPACK_dstein LAPACK_GLOBAL(dstein,DSTEIN)
-#define LAPACK_cstein LAPACK_GLOBAL(cstein,CSTEIN)
-#define LAPACK_zstein LAPACK_GLOBAL(zstein,ZSTEIN)
-#define LAPACK_sdisna LAPACK_GLOBAL(sdisna,SDISNA)
-#define LAPACK_ddisna LAPACK_GLOBAL(ddisna,DDISNA)
-#define LAPACK_ssygst LAPACK_GLOBAL(ssygst,SSYGST)
-#define LAPACK_dsygst LAPACK_GLOBAL(dsygst,DSYGST)
-#define LAPACK_chegst LAPACK_GLOBAL(chegst,CHEGST)
-#define LAPACK_zhegst LAPACK_GLOBAL(zhegst,ZHEGST)
-#define LAPACK_sspgst LAPACK_GLOBAL(sspgst,SSPGST)
-#define LAPACK_dspgst LAPACK_GLOBAL(dspgst,DSPGST)
-#define LAPACK_chpgst LAPACK_GLOBAL(chpgst,CHPGST)
-#define LAPACK_zhpgst LAPACK_GLOBAL(zhpgst,ZHPGST)
-#define LAPACK_ssbgst LAPACK_GLOBAL(ssbgst,SSBGST)
-#define LAPACK_dsbgst LAPACK_GLOBAL(dsbgst,DSBGST)
-#define LAPACK_chbgst LAPACK_GLOBAL(chbgst,CHBGST)
-#define LAPACK_zhbgst LAPACK_GLOBAL(zhbgst,ZHBGST)
-#define LAPACK_spbstf LAPACK_GLOBAL(spbstf,SPBSTF)
-#define LAPACK_dpbstf LAPACK_GLOBAL(dpbstf,DPBSTF)
-#define LAPACK_cpbstf LAPACK_GLOBAL(cpbstf,CPBSTF)
-#define LAPACK_zpbstf LAPACK_GLOBAL(zpbstf,ZPBSTF)
-#define LAPACK_sgehrd LAPACK_GLOBAL(sgehrd,SGEHRD)
-#define LAPACK_dgehrd LAPACK_GLOBAL(dgehrd,DGEHRD)
-#define LAPACK_cgehrd LAPACK_GLOBAL(cgehrd,CGEHRD)
-#define LAPACK_zgehrd LAPACK_GLOBAL(zgehrd,ZGEHRD)
-#define LAPACK_sorghr LAPACK_GLOBAL(sorghr,SORGHR)
-#define LAPACK_dorghr LAPACK_GLOBAL(dorghr,DORGHR)
-#define LAPACK_sormhr LAPACK_GLOBAL(sormhr,SORMHR)
-#define LAPACK_dormhr LAPACK_GLOBAL(dormhr,DORMHR)
-#define LAPACK_cunghr LAPACK_GLOBAL(cunghr,CUNGHR)
-#define LAPACK_zunghr LAPACK_GLOBAL(zunghr,ZUNGHR)
-#define LAPACK_cunmhr LAPACK_GLOBAL(cunmhr,CUNMHR)
-#define LAPACK_zunmhr LAPACK_GLOBAL(zunmhr,ZUNMHR)
-#define LAPACK_sgebal LAPACK_GLOBAL(sgebal,SGEBAL)
-#define LAPACK_dgebal LAPACK_GLOBAL(dgebal,DGEBAL)
-#define LAPACK_cgebal LAPACK_GLOBAL(cgebal,CGEBAL)
-#define LAPACK_zgebal LAPACK_GLOBAL(zgebal,ZGEBAL)
-#define LAPACK_sgebak LAPACK_GLOBAL(sgebak,SGEBAK)
-#define LAPACK_dgebak LAPACK_GLOBAL(dgebak,DGEBAK)
-#define LAPACK_cgebak LAPACK_GLOBAL(cgebak,CGEBAK)
-#define LAPACK_zgebak LAPACK_GLOBAL(zgebak,ZGEBAK)
-#define LAPACK_shseqr LAPACK_GLOBAL(shseqr,SHSEQR)
-#define LAPACK_dhseqr LAPACK_GLOBAL(dhseqr,DHSEQR)
-#define LAPACK_chseqr LAPACK_GLOBAL(chseqr,CHSEQR)
-#define LAPACK_zhseqr LAPACK_GLOBAL(zhseqr,ZHSEQR)
-#define LAPACK_shsein LAPACK_GLOBAL(shsein,SHSEIN)
-#define LAPACK_dhsein LAPACK_GLOBAL(dhsein,DHSEIN)
-#define LAPACK_chsein LAPACK_GLOBAL(chsein,CHSEIN)
-#define LAPACK_zhsein LAPACK_GLOBAL(zhsein,ZHSEIN)
-#define LAPACK_strevc LAPACK_GLOBAL(strevc,STREVC)
-#define LAPACK_dtrevc LAPACK_GLOBAL(dtrevc,DTREVC)
-#define LAPACK_ctrevc LAPACK_GLOBAL(ctrevc,CTREVC)
-#define LAPACK_ztrevc LAPACK_GLOBAL(ztrevc,ZTREVC)
-#define LAPACK_strsna LAPACK_GLOBAL(strsna,STRSNA)
-#define LAPACK_dtrsna LAPACK_GLOBAL(dtrsna,DTRSNA)
-#define LAPACK_ctrsna LAPACK_GLOBAL(ctrsna,CTRSNA)
-#define LAPACK_ztrsna LAPACK_GLOBAL(ztrsna,ZTRSNA)
-#define LAPACK_strexc LAPACK_GLOBAL(strexc,STREXC)
-#define LAPACK_dtrexc LAPACK_GLOBAL(dtrexc,DTREXC)
-#define LAPACK_ctrexc LAPACK_GLOBAL(ctrexc,CTREXC)
-#define LAPACK_ztrexc LAPACK_GLOBAL(ztrexc,ZTREXC)
-#define LAPACK_strsen LAPACK_GLOBAL(strsen,STRSEN)
-#define LAPACK_dtrsen LAPACK_GLOBAL(dtrsen,DTRSEN)
-#define LAPACK_ctrsen LAPACK_GLOBAL(ctrsen,CTRSEN)
-#define LAPACK_ztrsen LAPACK_GLOBAL(ztrsen,ZTRSEN)
-#define LAPACK_strsyl LAPACK_GLOBAL(strsyl,STRSYL)
-#define LAPACK_dtrsyl LAPACK_GLOBAL(dtrsyl,DTRSYL)
-#define LAPACK_ctrsyl LAPACK_GLOBAL(ctrsyl,CTRSYL)
-#define LAPACK_ztrsyl LAPACK_GLOBAL(ztrsyl,ZTRSYL)
-#define LAPACK_sgghrd LAPACK_GLOBAL(sgghrd,SGGHRD)
-#define LAPACK_dgghrd LAPACK_GLOBAL(dgghrd,DGGHRD)
-#define LAPACK_cgghrd LAPACK_GLOBAL(cgghrd,CGGHRD)
-#define LAPACK_zgghrd LAPACK_GLOBAL(zgghrd,ZGGHRD)
-#define LAPACK_sggbal LAPACK_GLOBAL(sggbal,SGGBAL)
-#define LAPACK_dggbal LAPACK_GLOBAL(dggbal,DGGBAL)
-#define LAPACK_cggbal LAPACK_GLOBAL(cggbal,CGGBAL)
-#define LAPACK_zggbal LAPACK_GLOBAL(zggbal,ZGGBAL)
-#define LAPACK_sggbak LAPACK_GLOBAL(sggbak,SGGBAK)
-#define LAPACK_dggbak LAPACK_GLOBAL(dggbak,DGGBAK)
-#define LAPACK_cggbak LAPACK_GLOBAL(cggbak,CGGBAK)
-#define LAPACK_zggbak LAPACK_GLOBAL(zggbak,ZGGBAK)
-#define LAPACK_shgeqz LAPACK_GLOBAL(shgeqz,SHGEQZ)
-#define LAPACK_dhgeqz LAPACK_GLOBAL(dhgeqz,DHGEQZ)
-#define LAPACK_chgeqz LAPACK_GLOBAL(chgeqz,CHGEQZ)
-#define LAPACK_zhgeqz LAPACK_GLOBAL(zhgeqz,ZHGEQZ)
-#define LAPACK_stgevc LAPACK_GLOBAL(stgevc,STGEVC)
-#define LAPACK_dtgevc LAPACK_GLOBAL(dtgevc,DTGEVC)
-#define LAPACK_ctgevc LAPACK_GLOBAL(ctgevc,CTGEVC)
-#define LAPACK_ztgevc LAPACK_GLOBAL(ztgevc,ZTGEVC)
-#define LAPACK_stgexc LAPACK_GLOBAL(stgexc,STGEXC)
-#define LAPACK_dtgexc LAPACK_GLOBAL(dtgexc,DTGEXC)
-#define LAPACK_ctgexc LAPACK_GLOBAL(ctgexc,CTGEXC)
-#define LAPACK_ztgexc LAPACK_GLOBAL(ztgexc,ZTGEXC)
-#define LAPACK_stgsen LAPACK_GLOBAL(stgsen,STGSEN)
-#define LAPACK_dtgsen LAPACK_GLOBAL(dtgsen,DTGSEN)
-#define LAPACK_ctgsen LAPACK_GLOBAL(ctgsen,CTGSEN)
-#define LAPACK_ztgsen LAPACK_GLOBAL(ztgsen,ZTGSEN)
-#define LAPACK_stgsyl LAPACK_GLOBAL(stgsyl,STGSYL)
-#define LAPACK_dtgsyl LAPACK_GLOBAL(dtgsyl,DTGSYL)
-#define LAPACK_ctgsyl LAPACK_GLOBAL(ctgsyl,CTGSYL)
-#define LAPACK_ztgsyl LAPACK_GLOBAL(ztgsyl,ZTGSYL)
-#define LAPACK_stgsna LAPACK_GLOBAL(stgsna,STGSNA)
-#define LAPACK_dtgsna LAPACK_GLOBAL(dtgsna,DTGSNA)
-#define LAPACK_ctgsna LAPACK_GLOBAL(ctgsna,CTGSNA)
-#define LAPACK_ztgsna LAPACK_GLOBAL(ztgsna,ZTGSNA)
-#define LAPACK_sggsvp LAPACK_GLOBAL(sggsvp,SGGSVP)
-#define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP)
-#define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP)
-#define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP)
-#define LAPACK_stgsja LAPACK_GLOBAL(stgsja,STGSJA)
-#define LAPACK_dtgsja LAPACK_GLOBAL(dtgsja,DTGSJA)
-#define LAPACK_ctgsja LAPACK_GLOBAL(ctgsja,CTGSJA)
-#define LAPACK_ztgsja LAPACK_GLOBAL(ztgsja,ZTGSJA)
-#define LAPACK_sgels LAPACK_GLOBAL(sgels,SGELS)
-#define LAPACK_dgels LAPACK_GLOBAL(dgels,DGELS)
-#define LAPACK_cgels LAPACK_GLOBAL(cgels,CGELS)
-#define LAPACK_zgels LAPACK_GLOBAL(zgels,ZGELS)
-#define LAPACK_sgelsy LAPACK_GLOBAL(sgelsy,SGELSY)
-#define LAPACK_dgelsy LAPACK_GLOBAL(dgelsy,DGELSY)
-#define LAPACK_cgelsy LAPACK_GLOBAL(cgelsy,CGELSY)
-#define LAPACK_zgelsy LAPACK_GLOBAL(zgelsy,ZGELSY)
-#define LAPACK_sgelss LAPACK_GLOBAL(sgelss,SGELSS)
-#define LAPACK_dgelss LAPACK_GLOBAL(dgelss,DGELSS)
-#define LAPACK_cgelss LAPACK_GLOBAL(cgelss,CGELSS)
-#define LAPACK_zgelss LAPACK_GLOBAL(zgelss,ZGELSS)
-#define LAPACK_sgelsd LAPACK_GLOBAL(sgelsd,SGELSD)
-#define LAPACK_dgelsd LAPACK_GLOBAL(dgelsd,DGELSD)
-#define LAPACK_cgelsd LAPACK_GLOBAL(cgelsd,CGELSD)
-#define LAPACK_zgelsd LAPACK_GLOBAL(zgelsd,ZGELSD)
-#define LAPACK_sgglse LAPACK_GLOBAL(sgglse,SGGLSE)
-#define LAPACK_dgglse LAPACK_GLOBAL(dgglse,DGGLSE)
-#define LAPACK_cgglse LAPACK_GLOBAL(cgglse,CGGLSE)
-#define LAPACK_zgglse LAPACK_GLOBAL(zgglse,ZGGLSE)
-#define LAPACK_sggglm LAPACK_GLOBAL(sggglm,SGGGLM)
-#define LAPACK_dggglm LAPACK_GLOBAL(dggglm,DGGGLM)
-#define LAPACK_cggglm LAPACK_GLOBAL(cggglm,CGGGLM)
-#define LAPACK_zggglm LAPACK_GLOBAL(zggglm,ZGGGLM)
-#define LAPACK_ssyev LAPACK_GLOBAL(ssyev,SSYEV)
-#define LAPACK_dsyev LAPACK_GLOBAL(dsyev,DSYEV)
-#define LAPACK_cheev LAPACK_GLOBAL(cheev,CHEEV)
-#define LAPACK_zheev LAPACK_GLOBAL(zheev,ZHEEV)
-#define LAPACK_ssyevd LAPACK_GLOBAL(ssyevd,SSYEVD)
-#define LAPACK_dsyevd LAPACK_GLOBAL(dsyevd,DSYEVD)
-#define LAPACK_cheevd LAPACK_GLOBAL(cheevd,CHEEVD)
-#define LAPACK_zheevd LAPACK_GLOBAL(zheevd,ZHEEVD)
-#define LAPACK_ssyevx LAPACK_GLOBAL(ssyevx,SSYEVX)
-#define LAPACK_dsyevx LAPACK_GLOBAL(dsyevx,DSYEVX)
-#define LAPACK_cheevx LAPACK_GLOBAL(cheevx,CHEEVX)
-#define LAPACK_zheevx LAPACK_GLOBAL(zheevx,ZHEEVX)
-#define LAPACK_ssyevr LAPACK_GLOBAL(ssyevr,SSYEVR)
-#define LAPACK_dsyevr LAPACK_GLOBAL(dsyevr,DSYEVR)
-#define LAPACK_cheevr LAPACK_GLOBAL(cheevr,CHEEVR)
-#define LAPACK_zheevr LAPACK_GLOBAL(zheevr,ZHEEVR)
-#define LAPACK_sspev LAPACK_GLOBAL(sspev,SSPEV)
-#define LAPACK_dspev LAPACK_GLOBAL(dspev,DSPEV)
-#define LAPACK_chpev LAPACK_GLOBAL(chpev,CHPEV)
-#define LAPACK_zhpev LAPACK_GLOBAL(zhpev,ZHPEV)
-#define LAPACK_sspevd LAPACK_GLOBAL(sspevd,SSPEVD)
-#define LAPACK_dspevd LAPACK_GLOBAL(dspevd,DSPEVD)
-#define LAPACK_chpevd LAPACK_GLOBAL(chpevd,CHPEVD)
-#define LAPACK_zhpevd LAPACK_GLOBAL(zhpevd,ZHPEVD)
-#define LAPACK_sspevx LAPACK_GLOBAL(sspevx,SSPEVX)
-#define LAPACK_dspevx LAPACK_GLOBAL(dspevx,DSPEVX)
-#define LAPACK_chpevx LAPACK_GLOBAL(chpevx,CHPEVX)
-#define LAPACK_zhpevx LAPACK_GLOBAL(zhpevx,ZHPEVX)
-#define LAPACK_ssbev LAPACK_GLOBAL(ssbev,SSBEV)
-#define LAPACK_dsbev LAPACK_GLOBAL(dsbev,DSBEV)
-#define LAPACK_chbev LAPACK_GLOBAL(chbev,CHBEV)
-#define LAPACK_zhbev LAPACK_GLOBAL(zhbev,ZHBEV)
-#define LAPACK_ssbevd LAPACK_GLOBAL(ssbevd,SSBEVD)
-#define LAPACK_dsbevd LAPACK_GLOBAL(dsbevd,DSBEVD)
-#define LAPACK_chbevd LAPACK_GLOBAL(chbevd,CHBEVD)
-#define LAPACK_zhbevd LAPACK_GLOBAL(zhbevd,ZHBEVD)
-#define LAPACK_ssbevx LAPACK_GLOBAL(ssbevx,SSBEVX)
-#define LAPACK_dsbevx LAPACK_GLOBAL(dsbevx,DSBEVX)
-#define LAPACK_chbevx LAPACK_GLOBAL(chbevx,CHBEVX)
-#define LAPACK_zhbevx LAPACK_GLOBAL(zhbevx,ZHBEVX)
-#define LAPACK_sstev LAPACK_GLOBAL(sstev,SSTEV)
-#define LAPACK_dstev LAPACK_GLOBAL(dstev,DSTEV)
-#define LAPACK_sstevd LAPACK_GLOBAL(sstevd,SSTEVD)
-#define LAPACK_dstevd LAPACK_GLOBAL(dstevd,DSTEVD)
-#define LAPACK_sstevx LAPACK_GLOBAL(sstevx,SSTEVX)
-#define LAPACK_dstevx LAPACK_GLOBAL(dstevx,DSTEVX)
-#define LAPACK_sstevr LAPACK_GLOBAL(sstevr,SSTEVR)
-#define LAPACK_dstevr LAPACK_GLOBAL(dstevr,DSTEVR)
-#define LAPACK_sgees LAPACK_GLOBAL(sgees,SGEES)
-#define LAPACK_dgees LAPACK_GLOBAL(dgees,DGEES)
-#define LAPACK_cgees LAPACK_GLOBAL(cgees,CGEES)
-#define LAPACK_zgees LAPACK_GLOBAL(zgees,ZGEES)
-#define LAPACK_sgeesx LAPACK_GLOBAL(sgeesx,SGEESX)
-#define LAPACK_dgeesx LAPACK_GLOBAL(dgeesx,DGEESX)
-#define LAPACK_cgeesx LAPACK_GLOBAL(cgeesx,CGEESX)
-#define LAPACK_zgeesx LAPACK_GLOBAL(zgeesx,ZGEESX)
-#define LAPACK_sgeev LAPACK_GLOBAL(sgeev,SGEEV)
-#define LAPACK_dgeev LAPACK_GLOBAL(dgeev,DGEEV)
-#define LAPACK_cgeev LAPACK_GLOBAL(cgeev,CGEEV)
-#define LAPACK_zgeev LAPACK_GLOBAL(zgeev,ZGEEV)
-#define LAPACK_sgeevx LAPACK_GLOBAL(sgeevx,SGEEVX)
-#define LAPACK_dgeevx LAPACK_GLOBAL(dgeevx,DGEEVX)
-#define LAPACK_cgeevx LAPACK_GLOBAL(cgeevx,CGEEVX)
-#define LAPACK_zgeevx LAPACK_GLOBAL(zgeevx,ZGEEVX)
-#define LAPACK_sgesvd LAPACK_GLOBAL(sgesvd,SGESVD)
-#define LAPACK_dgesvd LAPACK_GLOBAL(dgesvd,DGESVD)
-#define LAPACK_cgesvd LAPACK_GLOBAL(cgesvd,CGESVD)
-#define LAPACK_zgesvd LAPACK_GLOBAL(zgesvd,ZGESVD)
-#define LAPACK_sgesdd LAPACK_GLOBAL(sgesdd,SGESDD)
-#define LAPACK_dgesdd LAPACK_GLOBAL(dgesdd,DGESDD)
-#define LAPACK_cgesdd LAPACK_GLOBAL(cgesdd,CGESDD)
-#define LAPACK_zgesdd LAPACK_GLOBAL(zgesdd,ZGESDD)
-#define LAPACK_dgejsv LAPACK_GLOBAL(dgejsv,DGEJSV)
-#define LAPACK_sgejsv LAPACK_GLOBAL(sgejsv,SGEJSV)
-#define LAPACK_dgesvj LAPACK_GLOBAL(dgesvj,DGESVJ)
-#define LAPACK_sgesvj LAPACK_GLOBAL(sgesvj,SGESVJ)
-#define LAPACK_sggsvd LAPACK_GLOBAL(sggsvd,SGGSVD)
-#define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD)
-#define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD)
-#define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD)
-#define LAPACK_ssygv LAPACK_GLOBAL(ssygv,SSYGV)
-#define LAPACK_dsygv LAPACK_GLOBAL(dsygv,DSYGV)
-#define LAPACK_chegv LAPACK_GLOBAL(chegv,CHEGV)
-#define LAPACK_zhegv LAPACK_GLOBAL(zhegv,ZHEGV)
-#define LAPACK_ssygvd LAPACK_GLOBAL(ssygvd,SSYGVD)
-#define LAPACK_dsygvd LAPACK_GLOBAL(dsygvd,DSYGVD)
-#define LAPACK_chegvd LAPACK_GLOBAL(chegvd,CHEGVD)
-#define LAPACK_zhegvd LAPACK_GLOBAL(zhegvd,ZHEGVD)
-#define LAPACK_ssygvx LAPACK_GLOBAL(ssygvx,SSYGVX)
-#define LAPACK_dsygvx LAPACK_GLOBAL(dsygvx,DSYGVX)
-#define LAPACK_chegvx LAPACK_GLOBAL(chegvx,CHEGVX)
-#define LAPACK_zhegvx LAPACK_GLOBAL(zhegvx,ZHEGVX)
-#define LAPACK_sspgv LAPACK_GLOBAL(sspgv,SSPGV)
-#define LAPACK_dspgv LAPACK_GLOBAL(dspgv,DSPGV)
-#define LAPACK_chpgv LAPACK_GLOBAL(chpgv,CHPGV)
-#define LAPACK_zhpgv LAPACK_GLOBAL(zhpgv,ZHPGV)
-#define LAPACK_sspgvd LAPACK_GLOBAL(sspgvd,SSPGVD)
-#define LAPACK_dspgvd LAPACK_GLOBAL(dspgvd,DSPGVD)
-#define LAPACK_chpgvd LAPACK_GLOBAL(chpgvd,CHPGVD)
-#define LAPACK_zhpgvd LAPACK_GLOBAL(zhpgvd,ZHPGVD)
-#define LAPACK_sspgvx LAPACK_GLOBAL(sspgvx,SSPGVX)
-#define LAPACK_dspgvx LAPACK_GLOBAL(dspgvx,DSPGVX)
-#define LAPACK_chpgvx LAPACK_GLOBAL(chpgvx,CHPGVX)
-#define LAPACK_zhpgvx LAPACK_GLOBAL(zhpgvx,ZHPGVX)
-#define LAPACK_ssbgv LAPACK_GLOBAL(ssbgv,SSBGV)
-#define LAPACK_dsbgv LAPACK_GLOBAL(dsbgv,DSBGV)
-#define LAPACK_chbgv LAPACK_GLOBAL(chbgv,CHBGV)
-#define LAPACK_zhbgv LAPACK_GLOBAL(zhbgv,ZHBGV)
-#define LAPACK_ssbgvd LAPACK_GLOBAL(ssbgvd,SSBGVD)
-#define LAPACK_dsbgvd LAPACK_GLOBAL(dsbgvd,DSBGVD)
-#define LAPACK_chbgvd LAPACK_GLOBAL(chbgvd,CHBGVD)
-#define LAPACK_zhbgvd LAPACK_GLOBAL(zhbgvd,ZHBGVD)
-#define LAPACK_ssbgvx LAPACK_GLOBAL(ssbgvx,SSBGVX)
-#define LAPACK_dsbgvx LAPACK_GLOBAL(dsbgvx,DSBGVX)
-#define LAPACK_chbgvx LAPACK_GLOBAL(chbgvx,CHBGVX)
-#define LAPACK_zhbgvx LAPACK_GLOBAL(zhbgvx,ZHBGVX)
-#define LAPACK_sgges LAPACK_GLOBAL(sgges,SGGES)
-#define LAPACK_dgges LAPACK_GLOBAL(dgges,DGGES)
-#define LAPACK_cgges LAPACK_GLOBAL(cgges,CGGES)
-#define LAPACK_zgges LAPACK_GLOBAL(zgges,ZGGES)
-#define LAPACK_sggesx LAPACK_GLOBAL(sggesx,SGGESX)
-#define LAPACK_dggesx LAPACK_GLOBAL(dggesx,DGGESX)
-#define LAPACK_cggesx LAPACK_GLOBAL(cggesx,CGGESX)
-#define LAPACK_zggesx LAPACK_GLOBAL(zggesx,ZGGESX)
-#define LAPACK_sggev LAPACK_GLOBAL(sggev,SGGEV)
-#define LAPACK_dggev LAPACK_GLOBAL(dggev,DGGEV)
-#define LAPACK_cggev LAPACK_GLOBAL(cggev,CGGEV)
-#define LAPACK_zggev LAPACK_GLOBAL(zggev,ZGGEV)
-#define LAPACK_sggevx LAPACK_GLOBAL(sggevx,SGGEVX)
-#define LAPACK_dggevx LAPACK_GLOBAL(dggevx,DGGEVX)
-#define LAPACK_cggevx LAPACK_GLOBAL(cggevx,CGGEVX)
-#define LAPACK_zggevx LAPACK_GLOBAL(zggevx,ZGGEVX)
-#define LAPACK_dsfrk LAPACK_GLOBAL(dsfrk,DSFRK)
-#define LAPACK_ssfrk LAPACK_GLOBAL(ssfrk,SSFRK)
-#define LAPACK_zhfrk LAPACK_GLOBAL(zhfrk,ZHFRK)
-#define LAPACK_chfrk LAPACK_GLOBAL(chfrk,CHFRK)
-#define LAPACK_dtfsm LAPACK_GLOBAL(dtfsm,DTFSM)
-#define LAPACK_stfsm LAPACK_GLOBAL(stfsm,STFSM)
-#define LAPACK_ztfsm LAPACK_GLOBAL(ztfsm,ZTFSM)
-#define LAPACK_ctfsm LAPACK_GLOBAL(ctfsm,CTFSM)
-#define LAPACK_dtfttp LAPACK_GLOBAL(dtfttp,DTFTTP)
-#define LAPACK_stfttp LAPACK_GLOBAL(stfttp,STFTTP)
-#define LAPACK_ztfttp LAPACK_GLOBAL(ztfttp,ZTFTTP)
-#define LAPACK_ctfttp LAPACK_GLOBAL(ctfttp,CTFTTP)
-#define LAPACK_dtfttr LAPACK_GLOBAL(dtfttr,DTFTTR)
-#define LAPACK_stfttr LAPACK_GLOBAL(stfttr,STFTTR)
-#define LAPACK_ztfttr LAPACK_GLOBAL(ztfttr,ZTFTTR)
-#define LAPACK_ctfttr LAPACK_GLOBAL(ctfttr,CTFTTR)
-#define LAPACK_dtpttf LAPACK_GLOBAL(dtpttf,DTPTTF)
-#define LAPACK_stpttf LAPACK_GLOBAL(stpttf,STPTTF)
-#define LAPACK_ztpttf LAPACK_GLOBAL(ztpttf,ZTPTTF)
-#define LAPACK_ctpttf LAPACK_GLOBAL(ctpttf,CTPTTF)
-#define LAPACK_dtpttr LAPACK_GLOBAL(dtpttr,DTPTTR)
-#define LAPACK_stpttr LAPACK_GLOBAL(stpttr,STPTTR)
-#define LAPACK_ztpttr LAPACK_GLOBAL(ztpttr,ZTPTTR)
-#define LAPACK_ctpttr LAPACK_GLOBAL(ctpttr,CTPTTR)
-#define LAPACK_dtrttf LAPACK_GLOBAL(dtrttf,DTRTTF)
-#define LAPACK_strttf LAPACK_GLOBAL(strttf,STRTTF)
-#define LAPACK_ztrttf LAPACK_GLOBAL(ztrttf,ZTRTTF)
-#define LAPACK_ctrttf LAPACK_GLOBAL(ctrttf,CTRTTF)
-#define LAPACK_dtrttp LAPACK_GLOBAL(dtrttp,DTRTTP)
-#define LAPACK_strttp LAPACK_GLOBAL(strttp,STRTTP)
-#define LAPACK_ztrttp LAPACK_GLOBAL(ztrttp,ZTRTTP)
-#define LAPACK_ctrttp LAPACK_GLOBAL(ctrttp,CTRTTP)
-#define LAPACK_sgeqrfp LAPACK_GLOBAL(sgeqrfp,SGEQRFP)
-#define LAPACK_dgeqrfp LAPACK_GLOBAL(dgeqrfp,DGEQRFP)
-#define LAPACK_cgeqrfp LAPACK_GLOBAL(cgeqrfp,CGEQRFP)
-#define LAPACK_zgeqrfp LAPACK_GLOBAL(zgeqrfp,ZGEQRFP)
-#define LAPACK_clacgv LAPACK_GLOBAL(clacgv,CLACGV)
-#define LAPACK_zlacgv LAPACK_GLOBAL(zlacgv,ZLACGV)
-#define LAPACK_slarnv LAPACK_GLOBAL(slarnv,SLARNV)
-#define LAPACK_dlarnv LAPACK_GLOBAL(dlarnv,DLARNV)
-#define LAPACK_clarnv LAPACK_GLOBAL(clarnv,CLARNV)
-#define LAPACK_zlarnv LAPACK_GLOBAL(zlarnv,ZLARNV)
-#define LAPACK_sgeqr2 LAPACK_GLOBAL(sgeqr2,SGEQR2)
-#define LAPACK_dgeqr2 LAPACK_GLOBAL(dgeqr2,DGEQR2)
-#define LAPACK_cgeqr2 LAPACK_GLOBAL(cgeqr2,CGEQR2)
-#define LAPACK_zgeqr2 LAPACK_GLOBAL(zgeqr2,ZGEQR2)
-#define LAPACK_slacpy LAPACK_GLOBAL(slacpy,SLACPY)
-#define LAPACK_dlacpy LAPACK_GLOBAL(dlacpy,DLACPY)
-#define LAPACK_clacpy LAPACK_GLOBAL(clacpy,CLACPY)
-#define LAPACK_zlacpy LAPACK_GLOBAL(zlacpy,ZLACPY)
-#define LAPACK_sgetf2 LAPACK_GLOBAL(sgetf2,SGETF2)
-#define LAPACK_dgetf2 LAPACK_GLOBAL(dgetf2,DGETF2)
-#define LAPACK_cgetf2 LAPACK_GLOBAL(cgetf2,CGETF2)
-#define LAPACK_zgetf2 LAPACK_GLOBAL(zgetf2,ZGETF2)
-#define LAPACK_slaswp LAPACK_GLOBAL(slaswp,SLASWP)
-#define LAPACK_dlaswp LAPACK_GLOBAL(dlaswp,DLASWP)
-#define LAPACK_claswp LAPACK_GLOBAL(claswp,CLASWP)
-#define LAPACK_zlaswp LAPACK_GLOBAL(zlaswp,ZLASWP)
-#define LAPACK_slange LAPACK_GLOBAL(slange,SLANGE)
-#define LAPACK_dlange LAPACK_GLOBAL(dlange,DLANGE)
-#define LAPACK_clange LAPACK_GLOBAL(clange,CLANGE)
-#define LAPACK_zlange LAPACK_GLOBAL(zlange,ZLANGE)
-#define LAPACK_clanhe LAPACK_GLOBAL(clanhe,CLANHE)
-#define LAPACK_zlanhe LAPACK_GLOBAL(zlanhe,ZLANHE)
-#define LAPACK_slansy LAPACK_GLOBAL(slansy,SLANSY)
-#define LAPACK_dlansy LAPACK_GLOBAL(dlansy,DLANSY)
-#define LAPACK_clansy LAPACK_GLOBAL(clansy,CLANSY)
-#define LAPACK_zlansy LAPACK_GLOBAL(zlansy,ZLANSY)
-#define LAPACK_slantr LAPACK_GLOBAL(slantr,SLANTR)
-#define LAPACK_dlantr LAPACK_GLOBAL(dlantr,DLANTR)
-#define LAPACK_clantr LAPACK_GLOBAL(clantr,CLANTR)
-#define LAPACK_zlantr LAPACK_GLOBAL(zlantr,ZLANTR)
-#define LAPACK_slamch LAPACK_GLOBAL(slamch,SLAMCH)
-#define LAPACK_dlamch LAPACK_GLOBAL(dlamch,DLAMCH)
-#define LAPACK_sgelq2 LAPACK_GLOBAL(sgelq2,SGELQ2)
-#define LAPACK_dgelq2 LAPACK_GLOBAL(dgelq2,DGELQ2)
-#define LAPACK_cgelq2 LAPACK_GLOBAL(cgelq2,CGELQ2)
-#define LAPACK_zgelq2 LAPACK_GLOBAL(zgelq2,ZGELQ2)
-#define LAPACK_slarfb LAPACK_GLOBAL(slarfb,SLARFB)
-#define LAPACK_dlarfb LAPACK_GLOBAL(dlarfb,DLARFB)
-#define LAPACK_clarfb LAPACK_GLOBAL(clarfb,CLARFB)
-#define LAPACK_zlarfb LAPACK_GLOBAL(zlarfb,ZLARFB)
-#define LAPACK_slarfg LAPACK_GLOBAL(slarfg,SLARFG)
-#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG)
-#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG)
-#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG)
-#define LAPACK_slarft LAPACK_GLOBAL(slarft,SLARFT)
-#define LAPACK_dlarft LAPACK_GLOBAL(dlarft,DLARFT)
-#define LAPACK_clarft LAPACK_GLOBAL(clarft,CLARFT)
-#define LAPACK_zlarft LAPACK_GLOBAL(zlarft,ZLARFT)
-#define LAPACK_slarfx LAPACK_GLOBAL(slarfx,SLARFX)
-#define LAPACK_dlarfx LAPACK_GLOBAL(dlarfx,DLARFX)
-#define LAPACK_clarfx LAPACK_GLOBAL(clarfx,CLARFX)
-#define LAPACK_zlarfx LAPACK_GLOBAL(zlarfx,ZLARFX)
-#define LAPACK_slatms LAPACK_GLOBAL(slatms,SLATMS)
-#define LAPACK_dlatms LAPACK_GLOBAL(dlatms,DLATMS)
-#define LAPACK_clatms LAPACK_GLOBAL(clatms,CLATMS)
-#define LAPACK_zlatms LAPACK_GLOBAL(zlatms,ZLATMS)
-#define LAPACK_slag2d LAPACK_GLOBAL(slag2d,SLAG2D)
-#define LAPACK_dlag2s LAPACK_GLOBAL(dlag2s,DLAG2S)
-#define LAPACK_clag2z LAPACK_GLOBAL(clag2z,CLAG2Z)
-#define LAPACK_zlag2c LAPACK_GLOBAL(zlag2c,ZLAG2C)
-#define LAPACK_slauum LAPACK_GLOBAL(slauum,SLAUUM)
-#define LAPACK_dlauum LAPACK_GLOBAL(dlauum,DLAUUM)
-#define LAPACK_clauum LAPACK_GLOBAL(clauum,CLAUUM)
-#define LAPACK_zlauum LAPACK_GLOBAL(zlauum,ZLAUUM)
-#define LAPACK_slagge LAPACK_GLOBAL(slagge,SLAGGE)
-#define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE)
-#define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE)
-#define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE)
-#define LAPACK_slaset LAPACK_GLOBAL(slaset,SLASET)
-#define LAPACK_dlaset LAPACK_GLOBAL(dlaset,DLASET)
-#define LAPACK_claset LAPACK_GLOBAL(claset,CLASET)
-#define LAPACK_zlaset LAPACK_GLOBAL(zlaset,ZLASET)
-#define LAPACK_slasrt LAPACK_GLOBAL(slasrt,SLASRT)
-#define LAPACK_dlasrt LAPACK_GLOBAL(dlasrt,DLASRT)
-#define LAPACK_slagsy LAPACK_GLOBAL(slagsy,SLAGSY)
-#define LAPACK_dlagsy LAPACK_GLOBAL(dlagsy,DLAGSY)
-#define LAPACK_clagsy LAPACK_GLOBAL(clagsy,CLAGSY)
-#define LAPACK_zlagsy LAPACK_GLOBAL(zlagsy,ZLAGSY)
-#define LAPACK_claghe LAPACK_GLOBAL(claghe,CLAGHE)
-#define LAPACK_zlaghe LAPACK_GLOBAL(zlaghe,ZLAGHE)
-#define LAPACK_slapmr LAPACK_GLOBAL(slapmr,SLAPMR)
-#define LAPACK_dlapmr LAPACK_GLOBAL(dlapmr,DLAPMR)
-#define LAPACK_clapmr LAPACK_GLOBAL(clapmr,CLAPMR)
-#define LAPACK_zlapmr LAPACK_GLOBAL(zlapmr,ZLAPMR)
-#define LAPACK_slapy2 LAPACK_GLOBAL(slapy2,SLAPY2)
-#define LAPACK_dlapy2 LAPACK_GLOBAL(dlapy2,DLAPY2)
-#define LAPACK_slapy3 LAPACK_GLOBAL(slapy3,SLAPY3)
-#define LAPACK_dlapy3 LAPACK_GLOBAL(dlapy3,DLAPY3)
-#define LAPACK_slartgp LAPACK_GLOBAL(slartgp,SLARTGP)
-#define LAPACK_dlartgp LAPACK_GLOBAL(dlartgp,DLARTGP)
-#define LAPACK_slartgs LAPACK_GLOBAL(slartgs,SLARTGS)
-#define LAPACK_dlartgs LAPACK_GLOBAL(dlartgs,DLARTGS)
-// LAPACK 3.3.0
-#define LAPACK_cbbcsd LAPACK_GLOBAL(cbbcsd,CBBCSD)
-#define LAPACK_cheswapr LAPACK_GLOBAL(cheswapr,CHESWAPR)
-#define LAPACK_chetri2 LAPACK_GLOBAL(chetri2,CHETRI2)
-#define LAPACK_chetri2x LAPACK_GLOBAL(chetri2x,CHETRI2X)
-#define LAPACK_chetrs2 LAPACK_GLOBAL(chetrs2,CHETRS2)
-#define LAPACK_csyconv LAPACK_GLOBAL(csyconv,CSYCONV)
-#define LAPACK_csyswapr LAPACK_GLOBAL(csyswapr,CSYSWAPR)
-#define LAPACK_csytri2 LAPACK_GLOBAL(csytri2,CSYTRI2)
-#define LAPACK_csytri2x LAPACK_GLOBAL(csytri2x,CSYTRI2X)
-#define LAPACK_csytrs2 LAPACK_GLOBAL(csytrs2,CSYTRS2)
-#define LAPACK_cunbdb LAPACK_GLOBAL(cunbdb,CUNBDB)
-#define LAPACK_cuncsd LAPACK_GLOBAL(cuncsd,CUNCSD)
-#define LAPACK_dbbcsd LAPACK_GLOBAL(dbbcsd,DBBCSD)
-#define LAPACK_dorbdb LAPACK_GLOBAL(dorbdb,DORBDB)
-#define LAPACK_dorcsd LAPACK_GLOBAL(dorcsd,DORCSD)
-#define LAPACK_dsyconv LAPACK_GLOBAL(dsyconv,DSYCONV)
-#define LAPACK_dsyswapr LAPACK_GLOBAL(dsyswapr,DSYSWAPR)
-#define LAPACK_dsytri2 LAPACK_GLOBAL(dsytri2,DSYTRI2)
-#define LAPACK_dsytri2x LAPACK_GLOBAL(dsytri2x,DSYTRI2X)
-#define LAPACK_dsytrs2 LAPACK_GLOBAL(dsytrs2,DSYTRS2)
-#define LAPACK_sbbcsd LAPACK_GLOBAL(sbbcsd,SBBCSD)
-#define LAPACK_sorbdb LAPACK_GLOBAL(sorbdb,SORBDB)
-#define LAPACK_sorcsd LAPACK_GLOBAL(sorcsd,SORCSD)
-#define LAPACK_ssyconv LAPACK_GLOBAL(ssyconv,SSYCONV)
-#define LAPACK_ssyswapr LAPACK_GLOBAL(ssyswapr,SSYSWAPR)
-#define LAPACK_ssytri2 LAPACK_GLOBAL(ssytri2,SSYTRI2)
-#define LAPACK_ssytri2x LAPACK_GLOBAL(ssytri2x,SSYTRI2X)
-#define LAPACK_ssytrs2 LAPACK_GLOBAL(ssytrs2,SSYTRS2)
-#define LAPACK_zbbcsd LAPACK_GLOBAL(zbbcsd,ZBBCSD)
-#define LAPACK_zheswapr LAPACK_GLOBAL(zheswapr,ZHESWAPR)
-#define LAPACK_zhetri2 LAPACK_GLOBAL(zhetri2,ZHETRI2)
-#define LAPACK_zhetri2x LAPACK_GLOBAL(zhetri2x,ZHETRI2X)
-#define LAPACK_zhetrs2 LAPACK_GLOBAL(zhetrs2,ZHETRS2)
-#define LAPACK_zsyconv LAPACK_GLOBAL(zsyconv,ZSYCONV)
-#define LAPACK_zsyswapr LAPACK_GLOBAL(zsyswapr,ZSYSWAPR)
-#define LAPACK_zsytri2 LAPACK_GLOBAL(zsytri2,ZSYTRI2)
-#define LAPACK_zsytri2x LAPACK_GLOBAL(zsytri2x,ZSYTRI2X)
-#define LAPACK_zsytrs2 LAPACK_GLOBAL(zsytrs2,ZSYTRS2)
-#define LAPACK_zunbdb LAPACK_GLOBAL(zunbdb,ZUNBDB)
-#define LAPACK_zuncsd LAPACK_GLOBAL(zuncsd,ZUNCSD)
-// LAPACK 3.4.0
-#define LAPACK_sgemqrt LAPACK_GLOBAL(sgemqrt,SGEMQRT)
-#define LAPACK_dgemqrt LAPACK_GLOBAL(dgemqrt,DGEMQRT)
-#define LAPACK_cgemqrt LAPACK_GLOBAL(cgemqrt,CGEMQRT)
-#define LAPACK_zgemqrt LAPACK_GLOBAL(zgemqrt,ZGEMQRT)
-#define LAPACK_sgeqrt LAPACK_GLOBAL(sgeqrt,SGEQRT)
-#define LAPACK_dgeqrt LAPACK_GLOBAL(dgeqrt,DGEQRT)
-#define LAPACK_cgeqrt LAPACK_GLOBAL(cgeqrt,CGEQRT)
-#define LAPACK_zgeqrt LAPACK_GLOBAL(zgeqrt,ZGEQRT)
-#define LAPACK_sgeqrt2 LAPACK_GLOBAL(sgeqrt2,SGEQRT2)
-#define LAPACK_dgeqrt2 LAPACK_GLOBAL(dgeqrt2,DGEQRT2)
-#define LAPACK_cgeqrt2 LAPACK_GLOBAL(cgeqrt2,CGEQRT2)
-#define LAPACK_zgeqrt2 LAPACK_GLOBAL(zgeqrt2,ZGEQRT2)
-#define LAPACK_sgeqrt3 LAPACK_GLOBAL(sgeqrt3,SGEQRT3)
-#define LAPACK_dgeqrt3 LAPACK_GLOBAL(dgeqrt3,DGEQRT3)
-#define LAPACK_cgeqrt3 LAPACK_GLOBAL(cgeqrt3,CGEQRT3)
-#define LAPACK_zgeqrt3 LAPACK_GLOBAL(zgeqrt3,ZGEQRT3)
-#define LAPACK_stpmqrt LAPACK_GLOBAL(stpmqrt,STPMQRT)
-#define LAPACK_dtpmqrt LAPACK_GLOBAL(dtpmqrt,DTPMQRT)
-#define LAPACK_ctpmqrt LAPACK_GLOBAL(ctpmqrt,CTPMQRT)
-#define LAPACK_ztpmqrt LAPACK_GLOBAL(ztpmqrt,ZTPMQRT)
-#define LAPACK_dtpqrt LAPACK_GLOBAL(dtpqrt,DTPQRT)
-#define LAPACK_ctpqrt LAPACK_GLOBAL(ctpqrt,CTPQRT)
-#define LAPACK_ztpqrt LAPACK_GLOBAL(ztpqrt,ZTPQRT)
-#define LAPACK_stpqrt2 LAPACK_GLOBAL(stpqrt2,STPQRT2)
-#define LAPACK_dtpqrt2 LAPACK_GLOBAL(dtpqrt2,DTPQRT2)
-#define LAPACK_ctpqrt2 LAPACK_GLOBAL(ctpqrt2,CTPQRT2)
-#define LAPACK_ztpqrt2 LAPACK_GLOBAL(ztpqrt2,ZTPQRT2)
-#define LAPACK_stprfb LAPACK_GLOBAL(stprfb,STPRFB)
-#define LAPACK_dtprfb LAPACK_GLOBAL(dtprfb,DTPRFB)
-#define LAPACK_ctprfb LAPACK_GLOBAL(ctprfb,CTPRFB)
-#define LAPACK_ztprfb LAPACK_GLOBAL(ztprfb,ZTPRFB)
-// LAPACK 3.X.X
-#define LAPACK_csyr LAPACK_GLOBAL(csyr,CSYR)
-#define LAPACK_zsyr LAPACK_GLOBAL(zsyr,ZSYR)
-#define LAPACK_ilaver LAPACK_GLOBAL(ilaver,ILAVER)
-
-void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgetrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgetrf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgetrf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, double* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_complex_float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_complex_double* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgttrf( lapack_int* n, float* dl, float* d, float* du, float* du2,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgttrf( lapack_int* n, double* dl, double* d, double* du,
- double* du2, lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgttrf( lapack_int* n, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* du2, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_zgttrf( lapack_int* n, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* du2, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_spotrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dpotrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_cpotrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zpotrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dpstrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* piv, lapack_int* rank, double* tol,
- double* work, lapack_int *info );
-void LAPACK_spstrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* piv, lapack_int* rank, float* tol, float* work,
- lapack_int *info );
-void LAPACK_zpstrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* piv, lapack_int* rank,
- double* tol, double* work, lapack_int *info );
-void LAPACK_cpstrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* piv, lapack_int* rank,
- float* tol, float* work, lapack_int *info );
-void LAPACK_dpftrf( char* transr, char* uplo, lapack_int* n, double* a,
- lapack_int *info );
-void LAPACK_spftrf( char* transr, char* uplo, lapack_int* n, float* a,
- lapack_int *info );
-void LAPACK_zpftrf( char* transr, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_cpftrf( char* transr, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_spptrf( char* uplo, lapack_int* n, float* ap, lapack_int *info );
-void LAPACK_dpptrf( char* uplo, lapack_int* n, double* ap, lapack_int *info );
-void LAPACK_cpptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_zpptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_spbtrf( char* uplo, lapack_int* n, lapack_int* kd, float* ab,
- lapack_int* ldab, lapack_int *info );
-void LAPACK_dpbtrf( char* uplo, lapack_int* n, lapack_int* kd, double* ab,
- lapack_int* ldab, lapack_int *info );
-void LAPACK_cpbtrf( char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab,
- lapack_int *info );
-void LAPACK_zpbtrf( char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_int *info );
-void LAPACK_spttrf( lapack_int* n, float* d, float* e, lapack_int *info );
-void LAPACK_dpttrf( lapack_int* n, double* d, double* e, lapack_int *info );
-void LAPACK_cpttrf( lapack_int* n, float* d, lapack_complex_float* e,
- lapack_int *info );
-void LAPACK_zpttrf( lapack_int* n, double* d, lapack_complex_double* e,
- lapack_int *info );
-void LAPACK_ssytrf( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dsytrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_csytrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zsytrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chetrf( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zhetrf( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssptrf( char* uplo, lapack_int* n, float* ap, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_dsptrf( char* uplo, lapack_int* n, double* ap, lapack_int* ipiv,
- lapack_int *info );
-void LAPACK_csptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zsptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_chptrf( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_zhptrf( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_sgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const lapack_int* ipiv,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zgetrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const float* ab, lapack_int* ldab,
- const lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const double* ab, lapack_int* ldab,
- const lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_float* ab,
- lapack_int* ldab, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_double* ab,
- lapack_int* ldab, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- const float* du2, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- const double* du2, const lapack_int* ipiv, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgttrs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spotrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpotrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* a, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_spptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zpptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_spbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const float* ab, lapack_int* ldab, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const double* ab, lapack_int* ldab, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_cpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spttrs( lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpttrs( lapack_int* n, lapack_int* nrhs, const double* d,
- const double* e, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpttrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zpttrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ssytrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_csytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zsytrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_chetrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zhetrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_ssptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const lapack_int* ipiv, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const lapack_int* ipiv, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_csptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zsptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zhptrs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_strtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* a, lapack_int* lda, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dtrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* a, lapack_int* lda,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_ctrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztrtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_stptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* ap, float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dtptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* ap, double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_ctptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* ap,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztptrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* ap,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_stbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dtbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ctbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_ztbtrs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgecon( char* norm, lapack_int* n, const float* a, lapack_int* lda,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgecon( char* norm, lapack_int* n, const double* a, lapack_int* lda,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgecon( char* norm, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgecon( char* norm, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const float* ab, lapack_int* ldab, const lapack_int* ipiv,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const double* ab, lapack_int* ldab, const lapack_int* ipiv,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgtcon( char* norm, lapack_int* n, const float* dl, const float* d,
- const float* du, const float* du2, const lapack_int* ipiv,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgtcon( char* norm, lapack_int* n, const double* dl,
- const double* d, const double* du, const double* du2,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgtcon( char* norm, lapack_int* n, const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- float* anorm, float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zgtcon( char* norm, lapack_int* n, const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- double* anorm, double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_spocon( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* anorm, float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpocon( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- double* anorm, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cpocon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* anorm, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpocon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* anorm, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sppcon( char* uplo, lapack_int* n, const float* ap, float* anorm,
- float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dppcon( char* uplo, lapack_int* n, const double* ap, double* anorm,
- double* rcond, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cppcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- float* anorm, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zppcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- double* anorm, double* rcond, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_spbcon( char* uplo, lapack_int* n, lapack_int* kd, const float* ab,
- lapack_int* ldab, float* anorm, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dpbcon( char* uplo, lapack_int* n, lapack_int* kd, const double* ab,
- lapack_int* ldab, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cpbcon( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_float* ab, lapack_int* ldab,
- float* anorm, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zpbcon( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_double* ab, lapack_int* ldab,
- double* anorm, double* rcond, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sptcon( lapack_int* n, const float* d, const float* e, float* anorm,
- float* rcond, float* work, lapack_int *info );
-void LAPACK_dptcon( lapack_int* n, const double* d, const double* e,
- double* anorm, double* rcond, double* work,
- lapack_int *info );
-void LAPACK_cptcon( lapack_int* n, const float* d,
- const lapack_complex_float* e, float* anorm, float* rcond,
- float* work, lapack_int *info );
-void LAPACK_zptcon( lapack_int* n, const double* d,
- const lapack_complex_double* e, double* anorm,
- double* rcond, double* work, lapack_int *info );
-void LAPACK_ssycon( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- const lapack_int* ipiv, float* anorm, float* rcond,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dsycon( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_csycon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv, float* anorm,
- float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zsycon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv, double* anorm,
- double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_checon( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv, float* anorm,
- float* rcond, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zhecon( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv, double* anorm,
- double* rcond, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_sspcon( char* uplo, lapack_int* n, const float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dspcon( char* uplo, lapack_int* n, const double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cspcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zspcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_chpcon( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_int* ipiv, float* anorm, float* rcond,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhpcon( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_int* ipiv, double* anorm, double* rcond,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_strcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const float* a, lapack_int* lda, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const double* a, lapack_int* lda, double* rcond,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- float* rcond, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- double* rcond, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const float* ap, float* rcond, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const double* ap, double* rcond, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_float* ap, float* rcond,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztpcon( char* norm, char* uplo, char* diag, lapack_int* n,
- const lapack_complex_double* ap, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const float* ab, lapack_int* ldab,
- float* rcond, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const double* ab, lapack_int* ldab,
- double* rcond, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const lapack_complex_float* ab,
- lapack_int* ldab, float* rcond, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_ztbcon( char* norm, char* uplo, char* diag, lapack_int* n,
- lapack_int* kd, const lapack_complex_double* ab,
- lapack_int* ldab, double* rcond,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgerfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* r,
- const double* c, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* r,
- const float* c, const float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* r, const double* c,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* r, const float* c,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const float* ab, lapack_int* ldab,
- const float* afb, lapack_int* ldafb, const lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const double* ab, lapack_int* ldab,
- const double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_float* ab,
- lapack_int* ldab, const lapack_complex_float* afb,
- lapack_int* ldafb, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, const lapack_complex_double* ab,
- lapack_int* ldab, const lapack_complex_double* afb,
- lapack_int* ldafb, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_dgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, const double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* r, const double* c,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, const float* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const float* r, const float* c,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const double* r, const double* c,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* afb, lapack_int* ldafb,
- const lapack_int* ipiv, const float* r, const float* c,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- const float* dlf, const float* df, const float* duf,
- const float* du2, const lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- const double* dlf, const double* df, const double* duf,
- const double* du2, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du,
- const lapack_complex_float* dlf,
- const lapack_complex_float* df,
- const lapack_complex_float* duf,
- const lapack_complex_float* du2, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgtrfs( char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du,
- const lapack_complex_double* dlf,
- const lapack_complex_double* df,
- const lapack_complex_double* duf,
- const lapack_complex_double* du2, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sporfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const float* af, lapack_int* ldaf,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zporfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_dporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const double* s, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const float* s, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const double* s, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const float* s, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_spprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const float* afp, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* ferr,
- float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const double* afp, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const float* ab, lapack_int* ldab, const float* afb,
- lapack_int* ldafb, const float* b, lapack_int* ldb,
- float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const double* ab, lapack_int* ldab, const double* afb,
- lapack_int* ldafb, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* afb, lapack_int* ldafb,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* afb, lapack_int* ldafb,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sptrfs( lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, const float* df, const float* ef,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int *info );
-void LAPACK_dptrfs( lapack_int* n, lapack_int* nrhs, const double* d,
- const double* e, const double* df, const double* ef,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int *info );
-void LAPACK_cptrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, const float* df,
- const lapack_complex_float* ef,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zptrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e,
- const double* df, const lapack_complex_double* ef,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a,
- lapack_int* lda, const float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* b, lapack_int* ldb,
- float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_csyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, const double* af,
- lapack_int* ldaf, const lapack_int* ipiv, const double* s,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_ssyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, const float* af,
- lapack_int* ldaf, const lapack_int* ipiv, const float* s,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_csyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_cherfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zherfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_zherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* af, lapack_int* ldaf,
- const lapack_int* ipiv, const double* s,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* af, lapack_int* ldaf,
- const lapack_int* ipiv, const float* s,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* berr, lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ssprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, const float* afp, const lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dsprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, const double* afp, const lapack_int* ipiv,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_csprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zsprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap,
- const lapack_complex_float* afp, const lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhprfs( char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap,
- const lapack_complex_double* afp, const lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* ferr,
- double* berr, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_strrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, const float* x,
- lapack_int* ldx, float* ferr, float* berr, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, const double* x,
- lapack_int* ldx, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, const lapack_complex_float* x,
- lapack_int* ldx, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, const lapack_complex_double* x,
- lapack_int* ldx, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const float* ap, const float* b,
- lapack_int* ldb, const float* x, lapack_int* ldx,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const double* ap, const double* b,
- lapack_int* ldb, const double* x, lapack_int* ldx,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* ap,
- const lapack_complex_float* b, lapack_int* ldb,
- const lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztprfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_double* ap,
- const lapack_complex_double* b, lapack_int* ldb,
- const lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_stbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const float* ab,
- lapack_int* ldab, const float* b, lapack_int* ldb,
- const float* x, lapack_int* ldx, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dtbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs, const double* ab,
- lapack_int* ldab, const double* b, lapack_int* ldb,
- const double* x, lapack_int* ldx, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* b, lapack_int* ldb,
- const lapack_complex_float* x, lapack_int* ldx, float* ferr,
- float* berr, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztbrfs( char* uplo, char* trans, char* diag, lapack_int* n,
- lapack_int* kd, lapack_int* nrhs,
- const lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* b, lapack_int* ldb,
- const lapack_complex_double* x, lapack_int* ldx,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sgetri( lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgetri( lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgetri( lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgetri( lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_spotri( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dpotri( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_cpotri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zpotri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dpftri( char* transr, char* uplo, lapack_int* n, double* a,
- lapack_int *info );
-void LAPACK_spftri( char* transr, char* uplo, lapack_int* n, float* a,
- lapack_int *info );
-void LAPACK_zpftri( char* transr, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_cpftri( char* transr, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_spptri( char* uplo, lapack_int* n, float* ap, lapack_int *info );
-void LAPACK_dpptri( char* uplo, lapack_int* n, double* ap, lapack_int *info );
-void LAPACK_cpptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_zpptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ssytri( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work, lapack_int *info );
-void LAPACK_dsytri( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work, lapack_int *info );
-void LAPACK_csytri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zsytri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_chetri( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhetri( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_ssptri( char* uplo, lapack_int* n, float* ap,
- const lapack_int* ipiv, float* work, lapack_int *info );
-void LAPACK_dsptri( char* uplo, lapack_int* n, double* ap,
- const lapack_int* ipiv, double* work, lapack_int *info );
-void LAPACK_csptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zsptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_chptri( char* uplo, lapack_int* n, lapack_complex_float* ap,
- const lapack_int* ipiv, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zhptri( char* uplo, lapack_int* n, lapack_complex_double* ap,
- const lapack_int* ipiv, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_strtri( char* uplo, char* diag, lapack_int* n, float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dtrtri( char* uplo, char* diag, lapack_int* n, double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ctrtri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_ztrtri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dtftri( char* transr, char* uplo, char* diag, lapack_int* n,
- double* a, lapack_int *info );
-void LAPACK_stftri( char* transr, char* uplo, char* diag, lapack_int* n,
- float* a, lapack_int *info );
-void LAPACK_ztftri( char* transr, char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* a, lapack_int *info );
-void LAPACK_ctftri( char* transr, char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* a, lapack_int *info );
-void LAPACK_stptri( char* uplo, char* diag, lapack_int* n, float* ap,
- lapack_int *info );
-void LAPACK_dtptri( char* uplo, char* diag, lapack_int* n, double* ap,
- lapack_int *info );
-void LAPACK_ctptri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_float* ap, lapack_int *info );
-void LAPACK_ztptri( char* uplo, char* diag, lapack_int* n,
- lapack_complex_double* ap, lapack_int *info );
-void LAPACK_sgeequ( lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_dgeequ( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_cgeequ( lapack_int* m, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgeequ( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* r,
- double* c, double* rowcnd, double* colcnd, double* amax,
- lapack_int *info );
-void LAPACK_dgeequb( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_sgeequb( lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgeequb( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* r,
- double* c, double* rowcnd, double* colcnd, double* amax,
- lapack_int *info );
-void LAPACK_cgeequb( lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* r,
- float* c, float* rowcnd, float* colcnd, float* amax,
- lapack_int *info );
-void LAPACK_sgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* ab, lapack_int* ldab, float* r,
- float* c, float* rowcnd, float* colcnd, float* amax,
- lapack_int *info );
-void LAPACK_dgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* ab, lapack_int* ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax, lapack_int *info );
-void LAPACK_cgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_float* ab,
- lapack_int* ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_zgbequ( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_double* ab,
- lapack_int* ldab, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_dgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* ab, lapack_int* ldab,
- double* r, double* c, double* rowcnd, double* colcnd,
- double* amax, lapack_int *info );
-void LAPACK_sgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* ab, lapack_int* ldab,
- float* r, float* c, float* rowcnd, float* colcnd,
- float* amax, lapack_int *info );
-void LAPACK_zgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_double* ab,
- lapack_int* ldab, double* r, double* c, double* rowcnd,
- double* colcnd, double* amax, lapack_int *info );
-void LAPACK_cgbequb( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const lapack_complex_float* ab,
- lapack_int* ldab, float* r, float* c, float* rowcnd,
- float* colcnd, float* amax, lapack_int *info );
-void LAPACK_spoequ( lapack_int* n, const float* a, lapack_int* lda, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_dpoequ( lapack_int* n, const double* a, lapack_int* lda, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_cpoequ( lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_zpoequ( lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_dpoequb( lapack_int* n, const double* a, lapack_int* lda, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_spoequb( lapack_int* n, const float* a, lapack_int* lda, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_zpoequb( lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_cpoequb( lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_sppequ( char* uplo, lapack_int* n, const float* ap, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_dppequ( char* uplo, lapack_int* n, const double* ap, double* s,
- double* scond, double* amax, lapack_int *info );
-void LAPACK_cppequ( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- float* s, float* scond, float* amax, lapack_int *info );
-void LAPACK_zppequ( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- double* s, double* scond, double* amax, lapack_int *info );
-void LAPACK_spbequ( char* uplo, lapack_int* n, lapack_int* kd, const float* ab,
- lapack_int* ldab, float* s, float* scond, float* amax,
- lapack_int *info );
-void LAPACK_dpbequ( char* uplo, lapack_int* n, lapack_int* kd, const double* ab,
- lapack_int* ldab, double* s, double* scond, double* amax,
- lapack_int *info );
-void LAPACK_cpbequ( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_float* ab, lapack_int* ldab, float* s,
- float* scond, float* amax, lapack_int *info );
-void LAPACK_zpbequ( char* uplo, lapack_int* n, lapack_int* kd,
- const lapack_complex_double* ab, lapack_int* ldab,
- double* s, double* scond, double* amax, lapack_int *info );
-void LAPACK_dsyequb( char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- double* work, lapack_int *info );
-void LAPACK_ssyequb( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* s, float* scond, float* amax, float* work,
- lapack_int *info );
-void LAPACK_zsyequb( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_csyequb( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zheequb( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, double* s, double* scond, double* amax,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_cheequb( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, float* s, float* scond, float* amax,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_sgesv( lapack_int* n, lapack_int* nrhs, float* a, lapack_int* lda,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_dsgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda,
- lapack_int* ipiv, double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* work, float* swork,
- lapack_int* iter, lapack_int *info );
-void LAPACK_zcgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, lapack_complex_float* swork,
- double* rwork, lapack_int* iter, lapack_int *info );
-void LAPACK_sgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* r, float* c,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, float* ab, lapack_int* ldab,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, double* ab, lapack_int* ldab,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, lapack_complex_float* ab, lapack_int* ldab,
- lapack_int* ipiv, lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku,
- lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_int* ipiv, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, float* ab,
- lapack_int* ldab, float* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, float* r, float* c, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, double* ab,
- lapack_int* ldab, double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, double* r,
- double* c, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, double* ab,
- lapack_int* ldab, double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- double* b, lapack_int* ldb, double* x, lapack_int* ldx,
- double* rcond, double* rpvgrw, double* berr,
- lapack_int* n_err_bnds, double* err_bnds_norm,
- double* err_bnds_comp, lapack_int* nparams, double* params,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, float* ab,
- lapack_int* ldab, float* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, float* r, float* c,
- float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* afb, lapack_int* ldafb,
- lapack_int* ipiv, char* equed, double* r, double* c,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl,
- lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r,
- float* c, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sgtsv( lapack_int* n, lapack_int* nrhs, float* dl, float* d,
- float* du, float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dgtsv( lapack_int* n, lapack_int* nrhs, double* dl, double* d,
- double* du, double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* dl,
- lapack_complex_float* d, lapack_complex_float* du,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* dl,
- lapack_complex_double* d, lapack_complex_double* du,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const float* dl, const float* d, const float* du,
- float* dlf, float* df, float* duf, float* du2,
- lapack_int* ipiv, const float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const double* dl, const double* d, const double* du,
- double* dlf, double* df, double* duf, double* du2,
- lapack_int* ipiv, const double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* dl,
- const lapack_complex_float* d,
- const lapack_complex_float* du, lapack_complex_float* dlf,
- lapack_complex_float* df, lapack_complex_float* duf,
- lapack_complex_float* du2, lapack_int* ipiv,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* dl,
- const lapack_complex_double* d,
- const lapack_complex_double* du, lapack_complex_double* dlf,
- lapack_complex_double* df, lapack_complex_double* duf,
- lapack_complex_double* du2, lapack_int* ipiv,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sposv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dsposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* work, float* swork,
- lapack_int* iter, lapack_int *info );
-void LAPACK_zcposv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, lapack_complex_float* swork,
- double* rwork, lapack_int* iter, lapack_int *info );
-void LAPACK_sposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- char* equed, float* s, float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* ferr, float* berr,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- char* equed, double* s, double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* ferr,
- double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf, char* equed,
- float* s, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf, char* equed,
- double* s, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_dposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- char* equed, double* s, double* b, lapack_int* ldb,
- double* x, lapack_int* ldx, double* rcond, double* rpvgrw,
- double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- char* equed, float* s, float* b, lapack_int* ldb, float* x,
- lapack_int* ldx, float* rcond, float* rpvgrw, float* berr,
- lapack_int* n_err_bnds, float* err_bnds_norm,
- float* err_bnds_comp, lapack_int* nparams, float* params,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_zposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf, char* equed,
- double* s, lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_cposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf, char* equed,
- float* s, lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sppsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dppsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cppsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zppsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* ap, float* afp, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* ap, double* afp, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_complex_float* afp,
- char* equed, float* s, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_complex_double* afp,
- char* equed, double* s, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- float* ab, lapack_int* ldab, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- double* ab, lapack_int* ldab, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs,
- lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_spbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, float* ab, lapack_int* ldab, float* afb,
- lapack_int* ldafb, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, double* ab, lapack_int* ldab, double* afb,
- lapack_int* ldafb, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_cpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* afb,
- lapack_int* ldafb, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_int* nrhs, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* afb,
- lapack_int* ldafb, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sptsv( lapack_int* n, lapack_int* nrhs, float* d, float* e,
- float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_dptsv( lapack_int* n, lapack_int* nrhs, double* d, double* e,
- double* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_cptsv( lapack_int* n, lapack_int* nrhs, float* d,
- lapack_complex_float* e, lapack_complex_float* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_zptsv( lapack_int* n, lapack_int* nrhs, double* d,
- lapack_complex_double* e, lapack_complex_double* b,
- lapack_int* ldb, lapack_int *info );
-void LAPACK_sptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d,
- const float* e, float* df, float* ef, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int *info );
-void LAPACK_dptsvx( char* fact, lapack_int* n, lapack_int* nrhs,
- const double* d, const double* e, double* df, double* ef,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* ferr, double* berr,
- double* work, lapack_int *info );
-void LAPACK_cptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d,
- const lapack_complex_float* e, float* df,
- lapack_complex_float* ef, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zptsvx( char* fact, lapack_int* n, lapack_int* nrhs,
- const double* d, const lapack_complex_double* e, double* df,
- lapack_complex_double* ef, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssysv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, lapack_int* ipiv, float* b, lapack_int* ldb,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dsysv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, lapack_int* ipiv, double* b,
- lapack_int* ldb, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_csysv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zsysv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* a, lapack_int* lda, float* af,
- lapack_int* ldaf, lapack_int* ipiv, const float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* ferr, float* berr, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* a, lapack_int* lda, double* af,
- lapack_int* ldaf, lapack_int* ipiv, const double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* ferr, double* berr, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_csysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_dsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s, double* b,
- lapack_int* ldb, double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s, float* b,
- lapack_int* ldb, float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_csysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_chesv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zhesv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_zhesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, double* s,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* x, lapack_int* ldx, double* rcond,
- double* rpvgrw, double* berr, lapack_int* n_err_bnds,
- double* err_bnds_norm, double* err_bnds_comp,
- lapack_int* nparams, double* params,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* af, lapack_int* ldaf,
- lapack_int* ipiv, char* equed, float* s,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* x, lapack_int* ldx, float* rcond,
- float* rpvgrw, float* berr, lapack_int* n_err_bnds,
- float* err_bnds_norm, float* err_bnds_comp,
- lapack_int* nparams, float* params,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_sspsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap,
- lapack_int* ipiv, float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dspsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap,
- lapack_int* ipiv, double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_cspsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zspsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const float* ap, float* afp, lapack_int* ipiv,
- const float* b, lapack_int* ldb, float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr, float* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const double* ap, double* afp, lapack_int* ipiv,
- const double* b, lapack_int* ldb, double* x,
- lapack_int* ldx, double* rcond, double* ferr, double* berr,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* afp,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* afp,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_chpsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* ap, lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb, lapack_int *info );
-void LAPACK_zhpsv( char* uplo, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* ap, lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_float* ap, lapack_complex_float* afp,
- lapack_int* ipiv, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx,
- float* rcond, float* ferr, float* berr,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs,
- const lapack_complex_double* ap, lapack_complex_double* afp,
- lapack_int* ipiv, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx,
- double* rcond, double* ferr, double* berr,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sgeqrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqrf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqrf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgeqpf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* jpvt, float* tau, float* work,
- lapack_int *info );
-void LAPACK_dgeqpf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* jpvt, double* tau, double* work,
- lapack_int *info );
-void LAPACK_cgeqpf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_float* tau, lapack_complex_float* work,
- float* rwork, lapack_int *info );
-void LAPACK_zgeqpf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_double* tau, lapack_complex_double* work,
- double* rwork, lapack_int *info );
-void LAPACK_sgeqp3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* jpvt, float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgeqp3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* jpvt, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgeqp3( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgeqp3( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* jpvt,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sorgqr( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgqr( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungqr( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungqr( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmqr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgelqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgelqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgelqf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgelqf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorglq( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorglq( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunglq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunglq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmlq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgeqlf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqlf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqlf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqlf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorgql( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgql( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungql( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungql( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunmql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmql( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgerqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgerqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgerqf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgerqf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sorgrq( lapack_int* m, lapack_int* n, lapack_int* k, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgrq( lapack_int* m, lapack_int* n, lapack_int* k, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungrq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungrq( lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cunmrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmrq( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_stzrzf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dtzrzf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ctzrzf( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ztzrzf( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmrz( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggqrf( lapack_int* n, lapack_int* m, lapack_int* p, float* a,
- lapack_int* lda, float* taua, float* b, lapack_int* ldb,
- float* taub, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggqrf( lapack_int* n, lapack_int* m, lapack_int* p, double* a,
- lapack_int* lda, double* taua, double* b, lapack_int* ldb,
- double* taub, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggqrf( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* taua, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zggqrf( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* taua, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sggrqf( lapack_int* m, lapack_int* p, lapack_int* n, float* a,
- lapack_int* lda, float* taua, float* b, lapack_int* ldb,
- float* taub, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggrqf( lapack_int* m, lapack_int* p, lapack_int* n, double* a,
- lapack_int* lda, double* taua, double* b, lapack_int* ldb,
- double* taub, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggrqf( lapack_int* m, lapack_int* p, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* taua, lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* taub,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zggrqf( lapack_int* m, lapack_int* p, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* taua, lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* taub,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgebrd( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* d, float* e, float* tauq, float* taup, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgebrd( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* d, double* e, double* tauq, double* taup,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgebrd( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, float* d, float* e,
- lapack_complex_float* tauq, lapack_complex_float* taup,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgebrd( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, double* d, double* e,
- lapack_complex_double* tauq, lapack_complex_double* taup,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, float* ab, lapack_int* ldab,
- float* d, float* e, float* q, lapack_int* ldq, float* pt,
- lapack_int* ldpt, float* c, lapack_int* ldc, float* work,
- lapack_int *info );
-void LAPACK_dgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, double* ab,
- lapack_int* ldab, double* d, double* e, double* q,
- lapack_int* ldq, double* pt, lapack_int* ldpt, double* c,
- lapack_int* ldc, double* work, lapack_int *info );
-void LAPACK_cgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, lapack_complex_float* ab,
- lapack_int* ldab, float* d, float* e,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* pt, lapack_int* ldpt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc,
- lapack_int* kl, lapack_int* ku, lapack_complex_double* ab,
- lapack_int* ldab, double* d, double* e,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* pt, lapack_int* ldpt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- float* a, lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- double* a, lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmbr( char* vect, char* side, char* trans, lapack_int* m,
- lapack_int* n, lapack_int* k,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, float* d, float* e,
- float* vt, lapack_int* ldvt, float* u, lapack_int* ldu,
- float* c, lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, double* d, double* e,
- double* vt, lapack_int* ldvt, double* u, lapack_int* ldu,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_cbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, float* d, float* e,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* c, lapack_int* ldc, float* work,
- lapack_int *info );
-void LAPACK_zbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt,
- lapack_int* nru, lapack_int* ncc, double* d, double* e,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_sbdsdc( char* uplo, char* compq, lapack_int* n, float* d, float* e,
- float* u, lapack_int* ldu, float* vt, lapack_int* ldvt,
- float* q, lapack_int* iq, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dbdsdc( char* uplo, char* compq, lapack_int* n, double* d,
- double* e, double* u, lapack_int* ldu, double* vt,
- lapack_int* ldvt, double* q, lapack_int* iq, double* work,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssytrd( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- float* d, float* e, float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dsytrd( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- double* d, double* e, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sorgtr( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- const float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dorgtr( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- const double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sormtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* tau, float* c, lapack_int* ldc, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dormtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* tau, double* c, lapack_int* ldc, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_chetrd( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, float* d, float* e,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zhetrd( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, double* d, double* e,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cungtr( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zungtr( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zunmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ssptrd( char* uplo, lapack_int* n, float* ap, float* d, float* e,
- float* tau, lapack_int *info );
-void LAPACK_dsptrd( char* uplo, lapack_int* n, double* ap, double* d, double* e,
- double* tau, lapack_int *info );
-void LAPACK_sopgtr( char* uplo, lapack_int* n, const float* ap,
- const float* tau, float* q, lapack_int* ldq, float* work,
- lapack_int *info );
-void LAPACK_dopgtr( char* uplo, lapack_int* n, const double* ap,
- const double* tau, double* q, lapack_int* ldq, double* work,
- lapack_int *info );
-void LAPACK_sopmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const float* ap, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dopmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const double* ap, const double* tau,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_chptrd( char* uplo, lapack_int* n, lapack_complex_float* ap,
- float* d, float* e, lapack_complex_float* tau,
- lapack_int *info );
-void LAPACK_zhptrd( char* uplo, lapack_int* n, lapack_complex_double* ap,
- double* d, double* e, lapack_complex_double* tau,
- lapack_int *info );
-void LAPACK_cupgtr( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- const lapack_complex_float* tau, lapack_complex_float* q,
- lapack_int* ldq, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zupgtr( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- const lapack_complex_double* tau, lapack_complex_double* q,
- lapack_int* ldq, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_cupmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_float* ap,
- const lapack_complex_float* tau, lapack_complex_float* c,
- lapack_int* ldc, lapack_complex_float* work,
- lapack_int *info );
-void LAPACK_zupmtr( char* side, char* uplo, char* trans, lapack_int* m,
- lapack_int* n, const lapack_complex_double* ap,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_ssbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* d, float* e, float* q,
- lapack_int* ldq, float* work, lapack_int *info );
-void LAPACK_dsbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* d, double* e,
- double* q, lapack_int* ldq, double* work,
- lapack_int *info );
-void LAPACK_chbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* d,
- float* e, lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zhbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* d,
- double* e, lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_ssterf( lapack_int* n, float* d, float* e, lapack_int *info );
-void LAPACK_dsterf( lapack_int* n, double* d, double* e, lapack_int *info );
-void LAPACK_ssteqr( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dsteqr( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_csteqr( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz, float* work,
- lapack_int *info );
-void LAPACK_zsteqr( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz, double* work,
- lapack_int *info );
-void LAPACK_sstemr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- lapack_int* nzc, lapack_int* isuppz, lapack_logical* tryrac,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dstemr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, lapack_int* m, double* w, double* z,
- lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz,
- lapack_logical* tryrac, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cstemr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz,
- lapack_logical* tryrac, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zstemr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* nzc,
- lapack_int* isuppz, lapack_logical* tryrac, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_sstedc( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dstedc( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cstedc( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zstedc( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sstegr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, lapack_int* isuppz, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_dstegr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, lapack_int* isuppz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_cstegr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_int* isuppz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zstegr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_int* isuppz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_spteqr( char* compz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dpteqr( char* compz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_cpteqr( char* compz, lapack_int* n, float* d, float* e,
- lapack_complex_float* z, lapack_int* ldz, float* work,
- lapack_int *info );
-void LAPACK_zpteqr( char* compz, lapack_int* n, double* d, double* e,
- lapack_complex_double* z, lapack_int* ldz, double* work,
- lapack_int *info );
-void LAPACK_sstebz( char* range, char* order, lapack_int* n, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- const float* d, const float* e, lapack_int* m,
- lapack_int* nsplit, float* w, lapack_int* iblock,
- lapack_int* isplit, float* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dstebz( char* range, char* order, lapack_int* n, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- const double* d, const double* e, lapack_int* m,
- lapack_int* nsplit, double* w, lapack_int* iblock,
- lapack_int* isplit, double* work, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_sstein( lapack_int* n, const float* d, const float* e,
- lapack_int* m, const float* w, const lapack_int* iblock,
- const lapack_int* isplit, float* z, lapack_int* ldz,
- float* work, lapack_int* iwork, lapack_int* ifailv,
- lapack_int *info );
-void LAPACK_dstein( lapack_int* n, const double* d, const double* e,
- lapack_int* m, const double* w, const lapack_int* iblock,
- const lapack_int* isplit, double* z, lapack_int* ldz,
- double* work, lapack_int* iwork, lapack_int* ifailv,
- lapack_int *info );
-void LAPACK_cstein( lapack_int* n, const float* d, const float* e,
- lapack_int* m, const float* w, const lapack_int* iblock,
- const lapack_int* isplit, lapack_complex_float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifailv, lapack_int *info );
-void LAPACK_zstein( lapack_int* n, const double* d, const double* e,
- lapack_int* m, const double* w, const lapack_int* iblock,
- const lapack_int* isplit, lapack_complex_double* z,
- lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifailv, lapack_int *info );
-void LAPACK_sdisna( char* job, lapack_int* m, lapack_int* n, const float* d,
- float* sep, lapack_int *info );
-void LAPACK_ddisna( char* job, lapack_int* m, lapack_int* n, const double* d,
- double* sep, lapack_int *info );
-void LAPACK_ssygst( lapack_int* itype, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, const float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_dsygst( lapack_int* itype, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, const double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_chegst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_zhegst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_int *info );
-void LAPACK_sspgst( lapack_int* itype, char* uplo, lapack_int* n, float* ap,
- const float* bp, lapack_int *info );
-void LAPACK_dspgst( lapack_int* itype, char* uplo, lapack_int* n, double* ap,
- const double* bp, lapack_int *info );
-void LAPACK_chpgst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_float* ap, const lapack_complex_float* bp,
- lapack_int *info );
-void LAPACK_zhpgst( lapack_int* itype, char* uplo, lapack_int* n,
- lapack_complex_double* ap, const lapack_complex_double* bp,
- lapack_int *info );
-void LAPACK_ssbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab,
- const float* bb, lapack_int* ldbb, float* x,
- lapack_int* ldx, float* work, lapack_int *info );
-void LAPACK_dsbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab,
- const double* bb, lapack_int* ldbb, double* x,
- lapack_int* ldx, double* work, lapack_int *info );
-void LAPACK_chbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- const lapack_complex_float* bb, lapack_int* ldbb,
- lapack_complex_float* x, lapack_int* ldx,
- lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- const lapack_complex_double* bb, lapack_int* ldbb,
- lapack_complex_double* x, lapack_int* ldx,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_spbstf( char* uplo, lapack_int* n, lapack_int* kb, float* bb,
- lapack_int* ldbb, lapack_int *info );
-void LAPACK_dpbstf( char* uplo, lapack_int* n, lapack_int* kb, double* bb,
- lapack_int* ldbb, lapack_int *info );
-void LAPACK_cpbstf( char* uplo, lapack_int* n, lapack_int* kb,
- lapack_complex_float* bb, lapack_int* ldbb,
- lapack_int *info );
-void LAPACK_zpbstf( char* uplo, lapack_int* n, lapack_int* kb,
- lapack_complex_double* bb, lapack_int* ldbb,
- lapack_int *info );
-void LAPACK_sgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a,
- lapack_int* lda, float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a,
- lapack_int* lda, double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a,
- lapack_int* lda, const float* tau, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a,
- lapack_int* lda, const double* tau, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sormhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, const float* a,
- lapack_int* lda, const float* tau, float* c,
- lapack_int* ldc, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dormhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, const double* a,
- lapack_int* lda, const double* tau, double* c,
- lapack_int* ldc, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cunmhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* tau, lapack_complex_float* c,
- lapack_int* ldc, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zunmhr( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* tau, lapack_complex_double* c,
- lapack_int* ldc, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sgebal( char* job, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ilo, lapack_int* ihi, float* scale,
- lapack_int *info );
-void LAPACK_dgebal( char* job, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ilo, lapack_int* ihi, double* scale,
- lapack_int *info );
-void LAPACK_cgebal( char* job, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ilo, lapack_int* ihi,
- float* scale, lapack_int *info );
-void LAPACK_zgebal( char* job, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ilo, lapack_int* ihi,
- double* scale, lapack_int *info );
-void LAPACK_sgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* scale, lapack_int* m,
- float* v, lapack_int* ldv, lapack_int *info );
-void LAPACK_dgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* scale, lapack_int* m,
- double* v, lapack_int* ldv, lapack_int *info );
-void LAPACK_cgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* scale, lapack_int* m,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_zgebak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* scale, lapack_int* m,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_shseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, float* h, lapack_int* ldh, float* wr,
- float* wi, float* z, lapack_int* ldz, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, double* h, lapack_int* ldh, double* wr,
- double* wi, double* z, lapack_int* ldz, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_chseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_float* h, lapack_int* ldh,
- lapack_complex_float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_double* h, lapack_int* ldh,
- lapack_complex_double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_shsein( char* job, char* eigsrc, char* initv,
- lapack_logical* select, lapack_int* n, const float* h,
- lapack_int* ldh, float* wr, const float* wi, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_dhsein( char* job, char* eigsrc, char* initv,
- lapack_logical* select, lapack_int* n, const double* h,
- lapack_int* ldh, double* wr, const double* wi, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_chsein( char* job, char* eigsrc, char* initv,
- const lapack_logical* select, lapack_int* n,
- const lapack_complex_float* h, lapack_int* ldh,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_float* work, float* rwork,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_zhsein( char* job, char* eigsrc, char* initv,
- const lapack_logical* select, lapack_int* n,
- const lapack_complex_double* h, lapack_int* ldh,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int* ifaill, lapack_int* ifailr, lapack_int *info );
-void LAPACK_strevc( char* side, char* howmny, lapack_logical* select,
- lapack_int* n, const float* t, lapack_int* ldt, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int *info );
-void LAPACK_dtrevc( char* side, char* howmny, lapack_logical* select,
- lapack_int* n, const double* t, lapack_int* ldt, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int *info );
-void LAPACK_ctrevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztrevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_strsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* t, lapack_int* ldt,
- const float* vl, lapack_int* ldvl, const float* vr,
- lapack_int* ldvr, float* s, float* sep, lapack_int* mm,
- lapack_int* m, float* work, lapack_int* ldwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dtrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* t, lapack_int* ldt,
- const double* vl, lapack_int* ldvl, const double* vr,
- lapack_int* ldvr, double* s, double* sep, lapack_int* mm,
- lapack_int* m, double* work, lapack_int* ldwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* t,
- lapack_int* ldt, const lapack_complex_float* vl,
- lapack_int* ldvl, const lapack_complex_float* vr,
- lapack_int* ldvr, float* s, float* sep, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int* ldwork, float* rwork, lapack_int *info );
-void LAPACK_ztrsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* t,
- lapack_int* ldt, const lapack_complex_double* vl,
- lapack_int* ldvl, const lapack_complex_double* vr,
- lapack_int* ldvr, double* s, double* sep, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work,
- lapack_int* ldwork, double* rwork, lapack_int *info );
-void LAPACK_strexc( char* compq, lapack_int* n, float* t, lapack_int* ldt,
- float* q, lapack_int* ldq, lapack_int* ifst,
- lapack_int* ilst, float* work, lapack_int *info );
-void LAPACK_dtrexc( char* compq, lapack_int* n, double* t, lapack_int* ldt,
- double* q, lapack_int* ldq, lapack_int* ifst,
- lapack_int* ilst, double* work, lapack_int *info );
-void LAPACK_ctrexc( char* compq, lapack_int* n, lapack_complex_float* t,
- lapack_int* ldt, lapack_complex_float* q, lapack_int* ldq,
- lapack_int* ifst, lapack_int* ilst, lapack_int *info );
-void LAPACK_ztrexc( char* compq, lapack_int* n, lapack_complex_double* t,
- lapack_int* ldt, lapack_complex_double* q, lapack_int* ldq,
- lapack_int* ifst, lapack_int* ilst, lapack_int *info );
-void LAPACK_strsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, float* t, lapack_int* ldt, float* q,
- lapack_int* ldq, float* wr, float* wi, lapack_int* m,
- float* s, float* sep, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dtrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, double* t, lapack_int* ldt, double* q,
- lapack_int* ldq, double* wr, double* wi, lapack_int* m,
- double* s, double* sep, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ctrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* w, lapack_int* m, float* s,
- float* sep, lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_ztrsen( char* job, char* compq, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* w, lapack_int* m, double* s,
- double* sep, lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_strsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, float* c, lapack_int* ldc,
- float* scale, lapack_int *info );
-void LAPACK_dtrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, double* c,
- lapack_int* ldc, double* scale, lapack_int *info );
-void LAPACK_ctrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, lapack_complex_float* c, lapack_int* ldc,
- float* scale, lapack_int *info );
-void LAPACK_ztrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, lapack_complex_double* c, lapack_int* ldc,
- double* scale, lapack_int *info );
-void LAPACK_sgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* q, lapack_int* ldq, float* z,
- lapack_int* ldz, lapack_int *info );
-void LAPACK_dgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* q, lapack_int* ldq, double* z,
- lapack_int* ldz, lapack_int *info );
-void LAPACK_cgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_int *info );
-void LAPACK_zgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_int *info );
-void LAPACK_sggbal( char* job, lapack_int* n, float* a, lapack_int* lda,
- float* b, lapack_int* ldb, lapack_int* ilo, lapack_int* ihi,
- float* lscale, float* rscale, float* work,
- lapack_int *info );
-void LAPACK_dggbal( char* job, lapack_int* n, double* a, lapack_int* lda,
- double* b, lapack_int* ldb, lapack_int* ilo,
- lapack_int* ihi, double* lscale, double* rscale,
- double* work, lapack_int *info );
-void LAPACK_cggbal( char* job, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* work, lapack_int *info );
-void LAPACK_zggbal( char* job, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* work, lapack_int *info );
-void LAPACK_sggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* lscale, const float* rscale,
- lapack_int* m, float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_dggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* lscale, const double* rscale,
- lapack_int* m, double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_cggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const float* lscale, const float* rscale,
- lapack_int* m, lapack_complex_float* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_zggbak( char* job, char* side, lapack_int* n, lapack_int* ilo,
- lapack_int* ihi, const double* lscale, const double* rscale,
- lapack_int* m, lapack_complex_double* v, lapack_int* ldv,
- lapack_int *info );
-void LAPACK_shgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, float* h, lapack_int* ldh,
- float* t, lapack_int* ldt, float* alphar, float* alphai,
- float* beta, float* q, lapack_int* ldq, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dhgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, double* h,
- lapack_int* ldh, double* t, lapack_int* ldt, double* alphar,
- double* alphai, double* beta, double* q, lapack_int* ldq,
- double* z, lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, lapack_complex_float* h,
- lapack_int* ldh, lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhgeqz( char* job, char* compq, char* compz, lapack_int* n,
- lapack_int* ilo, lapack_int* ihi, lapack_complex_double* h,
- lapack_int* ldh, lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_stgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* s, lapack_int* lds,
- const float* p, lapack_int* ldp, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, float* work,
- lapack_int *info );
-void LAPACK_dtgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* s, lapack_int* lds,
- const double* p, lapack_int* ldp, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr,
- lapack_int* mm, lapack_int* m, double* work,
- lapack_int *info );
-void LAPACK_ctgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* s,
- lapack_int* lds, const lapack_complex_float* p,
- lapack_int* ldp, lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_ztgevc( char* side, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* s,
- lapack_int* lds, const lapack_complex_double* p,
- lapack_int* ldp, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* mm, lapack_int* m,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_stgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* q, lapack_int* ldq, float* z, lapack_int* ldz,
- lapack_int* ifst, lapack_int* ilst, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dtgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* q, lapack_int* ldq, double* z, lapack_int* ldz,
- lapack_int* ifst, lapack_int* ilst, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_ctgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz, lapack_int* ifst,
- lapack_int* ilst, lapack_int *info );
-void LAPACK_ztgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* ifst,
- lapack_int* ilst, lapack_int *info );
-void LAPACK_stgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* alphar, float* alphai, float* beta,
- float* q, lapack_int* ldq, float* z, lapack_int* ldz,
- lapack_int* m, float* pl, float* pr, float* dif,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dtgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* alphar, double* alphai,
- double* beta, double* q, lapack_int* ldq, double* z,
- lapack_int* ldz, lapack_int* m, double* pl, double* pr,
- double* dif, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ctgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* z, lapack_int* ldz, lapack_int* m,
- float* pl, float* pr, float* dif,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_ztgsen( lapack_int* ijob, lapack_logical* wantq,
- lapack_logical* wantz, const lapack_logical* select,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* z, lapack_int* ldz, lapack_int* m,
- double* pl, double* pr, double* dif,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_stgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const float* a, lapack_int* lda, const float* b,
- lapack_int* ldb, float* c, lapack_int* ldc, const float* d,
- lapack_int* ldd, const float* e, lapack_int* lde, float* f,
- lapack_int* ldf, float* scale, float* dif, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dtgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const double* a, lapack_int* lda, const double* b,
- lapack_int* ldb, double* c, lapack_int* ldc,
- const double* d, lapack_int* ldd, const double* e,
- lapack_int* lde, double* f, lapack_int* ldf, double* scale,
- double* dif, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ctgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- const lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* c, lapack_int* ldc,
- const lapack_complex_float* d, lapack_int* ldd,
- const lapack_complex_float* e, lapack_int* lde,
- lapack_complex_float* f, lapack_int* ldf, float* scale,
- float* dif, lapack_complex_float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ztgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* c, lapack_int* ldc,
- const lapack_complex_double* d, lapack_int* ldd,
- const lapack_complex_double* e, lapack_int* lde,
- lapack_complex_double* f, lapack_int* ldf, double* scale,
- double* dif, lapack_complex_double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_stgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const float* a, lapack_int* lda,
- const float* b, lapack_int* ldb, const float* vl,
- lapack_int* ldvl, const float* vr, lapack_int* ldvr,
- float* s, float* dif, lapack_int* mm, lapack_int* m,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dtgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const double* a, lapack_int* lda,
- const double* b, lapack_int* ldb, const double* vl,
- lapack_int* ldvl, const double* vr, lapack_int* ldvr,
- double* s, double* dif, lapack_int* mm, lapack_int* m,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_ctgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, const lapack_complex_float* b,
- lapack_int* ldb, const lapack_complex_float* vl,
- lapack_int* ldvl, const lapack_complex_float* vr,
- lapack_int* ldvr, float* s, float* dif, lapack_int* mm,
- lapack_int* m, lapack_complex_float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_ztgsna( char* job, char* howmny, const lapack_logical* select,
- lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, const lapack_complex_double* b,
- lapack_int* ldb, const lapack_complex_double* vl,
- lapack_int* ldvl, const lapack_complex_double* vr,
- lapack_int* ldvr, double* s, double* dif, lapack_int* mm,
- lapack_int* m, lapack_complex_double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_sggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, float* a, lapack_int* lda,
- float* b, lapack_int* ldb, float* tola, float* tolb,
- lapack_int* k, lapack_int* l, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* q, lapack_int* ldq,
- lapack_int* iwork, float* tau, float* work,
- lapack_int *info );
-void LAPACK_dggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, double* a, lapack_int* lda,
- double* b, lapack_int* ldb, double* tola, double* tolb,
- lapack_int* k, lapack_int* l, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* q, lapack_int* ldq,
- lapack_int* iwork, double* tau, double* work,
- lapack_int *info );
-void LAPACK_cggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* b, lapack_int* ldb,
- float* tola, float* tolb, lapack_int* k, lapack_int* l,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq, lapack_int* iwork,
- float* rwork, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* b, lapack_int* ldb,
- double* tola, double* tolb, lapack_int* k, lapack_int* l,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_int* iwork, double* rwork,
- lapack_complex_double* tau, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_stgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* tola, float* tolb, float* alpha, float* beta,
- float* u, lapack_int* ldu, float* v, lapack_int* ldv,
- float* q, lapack_int* ldq, float* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_dtgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* tola, double* tolb, double* alpha, double* beta,
- double* u, lapack_int* ldu, double* v, lapack_int* ldv,
- double* q, lapack_int* ldq, double* work,
- lapack_int* ncycle, lapack_int *info );
-void LAPACK_ctgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* tola,
- float* tolb, float* alpha, float* beta,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_ztgsja( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* tola,
- double* tolb, double* alpha, double* beta,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, lapack_int* ncycle,
- lapack_int *info );
-void LAPACK_sgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_sgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int* jpvt, float* rcond, lapack_int* rank,
- float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* jpvt, double* rcond, lapack_int* rank,
- double* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_cgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* jpvt,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* jpvt,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int *info );
-void LAPACK_zgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* s,
- float* rcond, lapack_int* rank, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_zgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* s,
- double* rcond, lapack_int* rank,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_sgglse( lapack_int* m, lapack_int* n, lapack_int* p, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* c,
- float* d, float* x, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgglse( lapack_int* m, lapack_int* n, lapack_int* p, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* c,
- double* d, double* x, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgglse( lapack_int* m, lapack_int* n, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* c, lapack_complex_float* d,
- lapack_complex_float* x, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zgglse( lapack_int* m, lapack_int* n, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* c, lapack_complex_double* d,
- lapack_complex_double* x, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggglm( lapack_int* n, lapack_int* m, lapack_int* p, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* d,
- float* x, float* y, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggglm( lapack_int* n, lapack_int* m, lapack_int* p, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* d,
- double* x, double* y, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cggglm( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* d, lapack_complex_float* x,
- lapack_complex_float* y, lapack_complex_float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_zggglm( lapack_int* n, lapack_int* m, lapack_int* p,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* d, lapack_complex_double* x,
- lapack_complex_double* y, lapack_complex_double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_ssyev( char* jobz, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, float* w, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dsyev( char* jobz, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, double* w, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cheev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zheev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_ssyevd( char* jobz, char* uplo, lapack_int* n, float* a,
- lapack_int* lda, float* w, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsyevd( char* jobz, char* uplo, lapack_int* n, double* a,
- lapack_int* lda, double* w, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cheevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zheevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssyevx( char* jobz, char* range, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsyevx( char* jobz, char* range, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_cheevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zheevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_ssyevr( char* jobz, char* range, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- lapack_int* isuppz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsyevr( char* jobz, char* range, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- lapack_int* isuppz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_cheevr( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_int* isuppz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zheevr( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_int* isuppz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspev( char* jobz, char* uplo, lapack_int* n, float* ap, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dspev( char* jobz, char* uplo, lapack_int* n, double* ap, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chpev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int *info );
-void LAPACK_zhpev( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sspevd( char* jobz, char* uplo, lapack_int* n, float* ap, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dspevd( char* jobz, char* uplo, lapack_int* n, double* ap,
- double* w, double* z, lapack_int* ldz, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_chpevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* lrwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_zhpevd( char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspevx( char* jobz, char* range, char* uplo, lapack_int* n,
- float* ap, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dspevx( char* jobz, char* range, char* uplo, lapack_int* n,
- double* ap, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chpevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_float* ap, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhpevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_complex_double* ap, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_ssbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dsbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- float* ab, lapack_int* ldab, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dsbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- double* ab, lapack_int* ldab, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_float* ab, lapack_int* ldab, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd,
- lapack_complex_double* ab, lapack_int* ldab, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, float* ab, lapack_int* ldab, float* q,
- lapack_int* ldq, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, double* ab, lapack_int* ldab, double* q,
- lapack_int* ldq, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* q, lapack_int* ldq, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhbevx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* kd, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* q, lapack_int* ldq, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_sstev( char* jobz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int *info );
-void LAPACK_dstev( char* jobz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_sstevd( char* jobz, lapack_int* n, float* d, float* e, float* z,
- lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_dstevd( char* jobz, lapack_int* n, double* d, double* e, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_sstevx( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dstevx( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_sstevr( char* jobz, char* range, lapack_int* n, float* d, float* e,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, lapack_int* isuppz, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_dstevr( char* jobz, char* range, lapack_int* n, double* d,
- double* e, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, lapack_int* isuppz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sgees( char* jobvs, char* sort, LAPACK_S_SELECT2 select,
- lapack_int* n, float* a, lapack_int* lda, lapack_int* sdim,
- float* wr, float* wi, float* vs, lapack_int* ldvs,
- float* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dgees( char* jobvs, char* sort, LAPACK_D_SELECT2 select,
- lapack_int* n, double* a, lapack_int* lda, lapack_int* sdim,
- double* wr, double* wi, double* vs, lapack_int* ldvs,
- double* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cgees( char* jobvs, char* sort, LAPACK_C_SELECT1 select,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int* ldvs,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_zgees( char* jobvs, char* sort, LAPACK_Z_SELECT1 select,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int* ldvs,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_logical* bwork, lapack_int *info );
-void LAPACK_sgeesx( char* jobvs, char* sort, LAPACK_S_SELECT2 select,
- char* sense, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* sdim, float* wr, float* wi, float* vs,
- lapack_int* ldvs, float* rconde, float* rcondv, float* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int* liwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_dgeesx( char* jobvs, char* sort, LAPACK_D_SELECT2 select,
- char* sense, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* sdim, double* wr, double* wi, double* vs,
- lapack_int* ldvs, double* rconde, double* rcondv,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cgeesx( char* jobvs, char* sort, LAPACK_C_SELECT1 select,
- char* sense, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* sdim, lapack_complex_float* w,
- lapack_complex_float* vs, lapack_int* ldvs, float* rconde,
- float* rcondv, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zgeesx( char* jobvs, char* sort, LAPACK_Z_SELECT1 select,
- char* sense, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* sdim, lapack_complex_double* w,
- lapack_complex_double* vs, lapack_int* ldvs, double* rconde,
- double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_sgeev( char* jobvl, char* jobvr, lapack_int* n, float* a,
- lapack_int* lda, float* wr, float* wi, float* vl,
- lapack_int* ldvl, float* vr, lapack_int* ldvr, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgeev( char* jobvl, char* jobvr, lapack_int* n, double* a,
- lapack_int* lda, double* wr, double* wi, double* vl,
- lapack_int* ldvl, double* vr, lapack_int* ldvr, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgeev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr, lapack_int* ldvr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgeev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, float* a, lapack_int* lda, float* wr,
- float* wi, float* vl, lapack_int* ldvl, float* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde, float* rcondv,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_dgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, double* a, lapack_int* lda, double* wr,
- double* wi, double* vl, lapack_int* ldvl, double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_cgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* w, lapack_complex_float* vl,
- lapack_int* ldvl, lapack_complex_float* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- float* scale, float* abnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgeevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* w, lapack_complex_double* vl,
- lapack_int* ldvl, lapack_complex_double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* scale, double* abnrm, double* rconde,
- double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int *info );
-void LAPACK_sgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- float* a, lapack_int* lda, float* s, float* u,
- lapack_int* ldu, float* vt, lapack_int* ldvt, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_dgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- double* a, lapack_int* lda, double* s, double* u,
- lapack_int* ldu, double* vt, lapack_int* ldvt, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* s,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* s,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sgesdd( char* jobz, lapack_int* m, lapack_int* n, float* a,
- lapack_int* lda, float* s, float* u, lapack_int* ldu,
- float* vt, lapack_int* ldvt, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dgesdd( char* jobz, lapack_int* m, lapack_int* n, double* a,
- lapack_int* lda, double* s, double* u, lapack_int* ldu,
- double* vt, lapack_int* ldvt, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_cgesdd( char* jobz, lapack_int* m, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda, float* s,
- lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* vt, lapack_int* ldvt,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_zgesdd( char* jobz, lapack_int* m, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda, double* s,
- lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* vt, lapack_int* ldvt,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* iwork, lapack_int *info );
-void LAPACK_dgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt,
- char* jobp, lapack_int* m, lapack_int* n, double* a,
- lapack_int* lda, double* sva, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_sgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt,
- char* jobp, lapack_int* m, lapack_int* n, float* a,
- lapack_int* lda, float* sva, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_dgesvj( char* joba, char* jobu, char* jobv, lapack_int* m,
- lapack_int* n, double* a, lapack_int* lda, double* sva,
- lapack_int* mv, double* v, lapack_int* ldv, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sgesvj( char* joba, char* jobu, char* jobv, lapack_int* m,
- lapack_int* n, float* a, lapack_int* lda, float* sva,
- lapack_int* mv, float* v, lapack_int* ldv, float* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_sggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* alpha, float* beta, float* u, lapack_int* ldu,
- float* v, lapack_int* ldv, float* q, lapack_int* ldq,
- float* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_dggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* alpha, double* beta, double* u, lapack_int* ldu,
- double* v, lapack_int* ldv, double* q, lapack_int* ldq,
- double* work, lapack_int* iwork, lapack_int *info );
-void LAPACK_cggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* alpha,
- float* beta, lapack_complex_float* u, lapack_int* ldu,
- lapack_complex_float* v, lapack_int* ldv,
- lapack_complex_float* q, lapack_int* ldq,
- lapack_complex_float* work, float* rwork, lapack_int* iwork,
- lapack_int *info );
-void LAPACK_zggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m,
- lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* alpha,
- double* beta, lapack_complex_double* u, lapack_int* ldu,
- lapack_complex_double* v, lapack_int* ldv,
- lapack_complex_double* q, lapack_int* ldq,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int *info );
-void LAPACK_ssygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* w, float* work, lapack_int* lwork, lapack_int *info );
-void LAPACK_dsygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* w, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_chegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zhegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_ssygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- float* w, float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dsygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* w, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* w,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* w,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssygvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* vl, float* vu, lapack_int* il,
- lapack_int* iu, float* abstol, lapack_int* m, float* w,
- float* z, lapack_int* ldz, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_dsygvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_chegvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, float* vl,
- float* vu, lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zhegvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_sspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* ap, float* bp, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int *info );
-void LAPACK_dspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* ap, double* bp, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int *info );
-void LAPACK_chpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, lapack_complex_float* bp, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double* w, lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_sspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- float* ap, float* bp, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- double* ap, double* bp, double* w, double* z,
- lapack_int* ldz, double* work, lapack_int* lwork,
- lapack_int* iwork, lapack_int* liwork, lapack_int *info );
-void LAPACK_chpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_float* ap, lapack_complex_float* bp,
- float* w, lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n,
- lapack_complex_double* ap, lapack_complex_double* bp,
- double* w, lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_sspgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, float* ap, float* bp, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* iwork, lapack_int* ifail,
- lapack_int *info );
-void LAPACK_dspgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, double* ap, double* bp, double* vl,
- double* vu, lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* iwork, lapack_int* ifail,
- lapack_int *info );
-void LAPACK_chpgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_float* ap,
- lapack_complex_float* bp, float* vl, float* vu,
- lapack_int* il, lapack_int* iu, float* abstol,
- lapack_int* m, float* w, lapack_complex_float* z,
- lapack_int* ldz, lapack_complex_float* work, float* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_zhpgvx( lapack_int* itype, char* jobz, char* range, char* uplo,
- lapack_int* n, lapack_complex_double* ap,
- lapack_complex_double* bp, double* vl, double* vu,
- lapack_int* il, lapack_int* iu, double* abstol,
- lapack_int* m, double* w, lapack_complex_double* z,
- lapack_int* ldz, lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_ssbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab, float* bb,
- lapack_int* ldbb, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int *info );
-void LAPACK_dsbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab, double* bb,
- lapack_int* ldbb, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int *info );
-void LAPACK_chbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* bb, lapack_int* ldbb, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int *info );
-void LAPACK_zhbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* bb, lapack_int* ldbb, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int *info );
-void LAPACK_ssbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, float* ab, lapack_int* ldab, float* bb,
- lapack_int* ldbb, float* w, float* z, lapack_int* ldz,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_dsbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, double* ab, lapack_int* ldab, double* bb,
- lapack_int* ldbb, double* w, double* z, lapack_int* ldz,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_chbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab,
- lapack_complex_float* bb, lapack_int* ldbb, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork,
- lapack_int *info );
-void LAPACK_zhbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka,
- lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab,
- lapack_complex_double* bb, lapack_int* ldbb, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork, lapack_int* iwork,
- lapack_int* liwork, lapack_int *info );
-void LAPACK_ssbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, float* ab, lapack_int* ldab,
- float* bb, lapack_int* ldbb, float* q, lapack_int* ldq,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w, float* z,
- lapack_int* ldz, float* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_dsbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, double* ab,
- lapack_int* ldab, double* bb, lapack_int* ldbb, double* q,
- lapack_int* ldq, double* vl, double* vu, lapack_int* il,
- lapack_int* iu, double* abstol, lapack_int* m, double* w,
- double* z, lapack_int* ldz, double* work, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_chbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, lapack_complex_float* ab,
- lapack_int* ldab, lapack_complex_float* bb,
- lapack_int* ldbb, lapack_complex_float* q, lapack_int* ldq,
- float* vl, float* vu, lapack_int* il, lapack_int* iu,
- float* abstol, lapack_int* m, float* w,
- lapack_complex_float* z, lapack_int* ldz,
- lapack_complex_float* work, float* rwork, lapack_int* iwork,
- lapack_int* ifail, lapack_int *info );
-void LAPACK_zhbgvx( char* jobz, char* range, char* uplo, lapack_int* n,
- lapack_int* ka, lapack_int* kb, lapack_complex_double* ab,
- lapack_int* ldab, lapack_complex_double* bb,
- lapack_int* ldbb, lapack_complex_double* q, lapack_int* ldq,
- double* vl, double* vu, lapack_int* il, lapack_int* iu,
- double* abstol, lapack_int* m, double* w,
- lapack_complex_double* z, lapack_int* ldz,
- lapack_complex_double* work, double* rwork,
- lapack_int* iwork, lapack_int* ifail, lapack_int *info );
-void LAPACK_sgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_S_SELECT3 selctg, lapack_int* n, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, lapack_int* sdim,
- float* alphar, float* alphai, float* beta, float* vsl,
- lapack_int* ldvsl, float* vsr, lapack_int* ldvsr,
- float* work, lapack_int* lwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_D_SELECT3 selctg, lapack_int* n, double* a,
- lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int* ldvsl, double* vsr,
- lapack_int* ldvsr, double* work, lapack_int* lwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_cgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_C_SELECT2 selctg, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int* ldvsl,
- lapack_complex_float* vsr, lapack_int* ldvsr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_zgges( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_Z_SELECT2 selctg, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int* ldvsl,
- lapack_complex_double* vsr, lapack_int* ldvsr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_logical* bwork, lapack_int *info );
-void LAPACK_sggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_S_SELECT3 selctg, char* sense, lapack_int* n,
- float* a, lapack_int* lda, float* b, lapack_int* ldb,
- lapack_int* sdim, float* alphar, float* alphai, float* beta,
- float* vsl, lapack_int* ldvsl, float* vsr,
- lapack_int* ldvsr, float* rconde, float* rcondv,
- float* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_D_SELECT3 selctg, char* sense, lapack_int* n,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- lapack_int* sdim, double* alphar, double* alphai,
- double* beta, double* vsl, lapack_int* ldvsl, double* vsr,
- lapack_int* ldvsr, double* rconde, double* rcondv,
- double* work, lapack_int* lwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_C_SELECT2 selctg, char* sense, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vsl, lapack_int* ldvsl,
- lapack_complex_float* vsr, lapack_int* ldvsr, float* rconde,
- float* rcondv, lapack_complex_float* work,
- lapack_int* lwork, float* rwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zggesx( char* jobvsl, char* jobvsr, char* sort,
- LAPACK_Z_SELECT2 selctg, char* sense, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vsl, lapack_int* ldvsl,
- lapack_complex_double* vsr, lapack_int* ldvsr,
- double* rconde, double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_int* liwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_sggev( char* jobvl, char* jobvr, lapack_int* n, float* a,
- lapack_int* lda, float* b, lapack_int* ldb, float* alphar,
- float* alphai, float* beta, float* vl, lapack_int* ldvl,
- float* vr, lapack_int* ldvr, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dggev( char* jobvl, char* jobvr, lapack_int* n, double* a,
- lapack_int* lda, double* b, lapack_int* ldb, double* alphar,
- double* alphai, double* beta, double* vl, lapack_int* ldvl,
- double* vr, lapack_int* ldvr, double* work,
- lapack_int* lwork, lapack_int *info );
-void LAPACK_cggev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int *info );
-void LAPACK_zggev( char* jobvl, char* jobvr, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int *info );
-void LAPACK_sggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* alphar, float* alphai, float* beta,
- float* vl, lapack_int* ldvl, float* vr, lapack_int* ldvr,
- lapack_int* ilo, lapack_int* ihi, float* lscale,
- float* rscale, float* abnrm, float* bbnrm, float* rconde,
- float* rcondv, float* work, lapack_int* lwork,
- lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_dggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* alphar, double* alphai,
- double* beta, double* vl, lapack_int* ldvl, double* vr,
- lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi,
- double* lscale, double* rscale, double* abnrm,
- double* bbnrm, double* rconde, double* rcondv, double* work,
- lapack_int* lwork, lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_cggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* vl, lapack_int* ldvl,
- lapack_complex_float* vr, lapack_int* ldvr, lapack_int* ilo,
- lapack_int* ihi, float* lscale, float* rscale, float* abnrm,
- float* bbnrm, float* rconde, float* rcondv,
- lapack_complex_float* work, lapack_int* lwork, float* rwork,
- lapack_int* iwork, lapack_logical* bwork,
- lapack_int *info );
-void LAPACK_zggevx( char* balanc, char* jobvl, char* jobvr, char* sense,
- lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* vl, lapack_int* ldvl,
- lapack_complex_double* vr, lapack_int* ldvr,
- lapack_int* ilo, lapack_int* ihi, double* lscale,
- double* rscale, double* abnrm, double* bbnrm,
- double* rconde, double* rcondv, lapack_complex_double* work,
- lapack_int* lwork, double* rwork, lapack_int* iwork,
- lapack_logical* bwork, lapack_int *info );
-void LAPACK_dsfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, double* alpha, const double* a,
- lapack_int* lda, double* beta, double* c );
-void LAPACK_ssfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, float* alpha, const float* a, lapack_int* lda,
- float* beta, float* c );
-void LAPACK_zhfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, double* alpha, const lapack_complex_double* a,
- lapack_int* lda, double* beta, lapack_complex_double* c );
-void LAPACK_chfrk( char* transr, char* uplo, char* trans, lapack_int* n,
- lapack_int* k, float* alpha, const lapack_complex_float* a,
- lapack_int* lda, float* beta, lapack_complex_float* c );
-void LAPACK_dtfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n, double* alpha,
- const double* a, double* b, lapack_int* ldb );
-void LAPACK_stfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n, float* alpha,
- const float* a, float* b, lapack_int* ldb );
-void LAPACK_ztfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n,
- lapack_complex_double* alpha, const lapack_complex_double* a,
- lapack_complex_double* b, lapack_int* ldb );
-void LAPACK_ctfsm( char* transr, char* side, char* uplo, char* trans,
- char* diag, lapack_int* m, lapack_int* n,
- lapack_complex_float* alpha, const lapack_complex_float* a,
- lapack_complex_float* b, lapack_int* ldb );
-void LAPACK_dtfttp( char* transr, char* uplo, lapack_int* n, const double* arf,
- double* ap, lapack_int *info );
-void LAPACK_stfttp( char* transr, char* uplo, lapack_int* n, const float* arf,
- float* ap, lapack_int *info );
-void LAPACK_ztfttp( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* arf, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ctfttp( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* arf, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_dtfttr( char* transr, char* uplo, lapack_int* n, const double* arf,
- double* a, lapack_int* lda, lapack_int *info );
-void LAPACK_stfttr( char* transr, char* uplo, lapack_int* n, const float* arf,
- float* a, lapack_int* lda, lapack_int *info );
-void LAPACK_ztfttr( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* arf, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ctfttr( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* arf, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_dtpttf( char* transr, char* uplo, lapack_int* n, const double* ap,
- double* arf, lapack_int *info );
-void LAPACK_stpttf( char* transr, char* uplo, lapack_int* n, const float* ap,
- float* arf, lapack_int *info );
-void LAPACK_ztpttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* ap, lapack_complex_double* arf,
- lapack_int *info );
-void LAPACK_ctpttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* ap, lapack_complex_float* arf,
- lapack_int *info );
-void LAPACK_dtpttr( char* uplo, lapack_int* n, const double* ap, double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_stpttr( char* uplo, lapack_int* n, const float* ap, float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_ztpttr( char* uplo, lapack_int* n, const lapack_complex_double* ap,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_ctpttr( char* uplo, lapack_int* n, const lapack_complex_float* ap,
- lapack_complex_float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dtrttf( char* transr, char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* arf, lapack_int *info );
-void LAPACK_strttf( char* transr, char* uplo, lapack_int* n, const float* a,
- lapack_int* lda, float* arf, lapack_int *info );
-void LAPACK_ztrttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* arf, lapack_int *info );
-void LAPACK_ctrttf( char* transr, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* arf, lapack_int *info );
-void LAPACK_dtrttp( char* uplo, lapack_int* n, const double* a, lapack_int* lda,
- double* ap, lapack_int *info );
-void LAPACK_strttp( char* uplo, lapack_int* n, const float* a, lapack_int* lda,
- float* ap, lapack_int *info );
-void LAPACK_ztrttp( char* uplo, lapack_int* n, const lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* ap,
- lapack_int *info );
-void LAPACK_ctrttp( char* uplo, lapack_int* n, const lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* ap,
- lapack_int *info );
-void LAPACK_sgeqrfp( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_dgeqrfp( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_cgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_zgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int* lwork,
- lapack_int *info );
-void LAPACK_clacgv( lapack_int* n, lapack_complex_float* x, lapack_int* incx );
-void LAPACK_zlacgv( lapack_int* n, lapack_complex_double* x, lapack_int* incx );
-void LAPACK_slarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- float* x );
-void LAPACK_dlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- double* x );
-void LAPACK_clarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- lapack_complex_float* x );
-void LAPACK_zlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n,
- lapack_complex_double* x );
-void LAPACK_sgeqr2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int *info );
-void LAPACK_dgeqr2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int *info );
-void LAPACK_cgeqr2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgeqr2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slacpy( char* uplo, lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* b, lapack_int* ldb );
-void LAPACK_dlacpy( char* uplo, lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* b, lapack_int* ldb );
-void LAPACK_clacpy( char* uplo, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb );
-void LAPACK_zlacpy( char* uplo, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb );
-void LAPACK_sgetf2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_dgetf2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- lapack_int* ipiv, lapack_int *info );
-void LAPACK_cgetf2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_zgetf2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int* ipiv, lapack_int *info );
-void LAPACK_slaswp( lapack_int* n, float* a, lapack_int* lda, lapack_int* k1,
- lapack_int* k2, const lapack_int* ipiv, lapack_int* incx );
-void LAPACK_dlaswp( lapack_int* n, double* a, lapack_int* lda, lapack_int* k1,
- lapack_int* k2, const lapack_int* ipiv, lapack_int* incx );
-void LAPACK_claswp( lapack_int* n, lapack_complex_float* a, lapack_int* lda,
- lapack_int* k1, lapack_int* k2, const lapack_int* ipiv,
- lapack_int* incx );
-void LAPACK_zlaswp( lapack_int* n, lapack_complex_double* a, lapack_int* lda,
- lapack_int* k1, lapack_int* k2, const lapack_int* ipiv,
- lapack_int* incx );
-float LAPACK_slange( char* norm, lapack_int* m, lapack_int* n, const float* a,
- lapack_int* lda, float* work );
-double LAPACK_dlange( char* norm, lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, double* work );
-float LAPACK_clange( char* norm, lapack_int* m, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlange( char* norm, lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_clanhe( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlanhe( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_slansy( char* norm, char* uplo, lapack_int* n, const float* a,
- lapack_int* lda, float* work );
-double LAPACK_dlansy( char* norm, char* uplo, lapack_int* n, const double* a,
- lapack_int* lda, double* work );
-float LAPACK_clansy( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_float* a, lapack_int* lda, float* work );
-double LAPACK_zlansy( char* norm, char* uplo, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda, double* work );
-float LAPACK_slantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const float* a, lapack_int* lda, float* work );
-double LAPACK_dlantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const double* a, lapack_int* lda, double* work );
-float LAPACK_clantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const lapack_complex_float* a, lapack_int* lda,
- float* work );
-double LAPACK_zlantr( char* norm, char* uplo, char* diag, lapack_int* m,
- lapack_int* n, const lapack_complex_double* a, lapack_int* lda,
- double* work );
-float LAPACK_slamch( char* cmach );
-double LAPACK_dlamch( char* cmach );
-void LAPACK_sgelq2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* tau, float* work, lapack_int *info );
-void LAPACK_dgelq2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* tau, double* work, lapack_int *info );
-void LAPACK_cgelq2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* tau,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgelq2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* tau,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, const float* v,
- lapack_int* ldv, const float* t, lapack_int* ldt, float* c,
- lapack_int* ldc, float* work, lapack_int* ldwork );
-void LAPACK_dlarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* c, lapack_int* ldc, double* work,
- lapack_int* ldwork );
-void LAPACK_clarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int* ldwork );
-void LAPACK_zlarfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int* ldwork );
-void LAPACK_slarfg( lapack_int* n, float* alpha, float* x, lapack_int* incx,
- float* tau );
-void LAPACK_dlarfg( lapack_int* n, double* alpha, double* x, lapack_int* incx,
- double* tau );
-void LAPACK_clarfg( lapack_int* n, lapack_complex_float* alpha,
- lapack_complex_float* x, lapack_int* incx,
- lapack_complex_float* tau );
-void LAPACK_zlarfg( lapack_int* n, lapack_complex_double* alpha,
- lapack_complex_double* x, lapack_int* incx,
- lapack_complex_double* tau );
-void LAPACK_slarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const float* v, lapack_int* ldv, const float* tau, float* t,
- lapack_int* ldt );
-void LAPACK_dlarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const double* v, lapack_int* ldv, const double* tau,
- double* t, lapack_int* ldt );
-void LAPACK_clarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* tau, lapack_complex_float* t,
- lapack_int* ldt );
-void LAPACK_zlarft( char* direct, char* storev, lapack_int* n, lapack_int* k,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* tau, lapack_complex_double* t,
- lapack_int* ldt );
-void LAPACK_slarfx( char* side, lapack_int* m, lapack_int* n, const float* v,
- float* tau, float* c, lapack_int* ldc, float* work );
-void LAPACK_dlarfx( char* side, lapack_int* m, lapack_int* n, const double* v,
- double* tau, double* c, lapack_int* ldc, double* work );
-void LAPACK_clarfx( char* side, lapack_int* m, lapack_int* n,
- const lapack_complex_float* v, lapack_complex_float* tau,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work );
-void LAPACK_zlarfx( char* side, lapack_int* m, lapack_int* n,
- const lapack_complex_double* v, lapack_complex_double* tau,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work );
-void LAPACK_slatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, float* d, lapack_int* mode, float* cond,
- float* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- float* a, lapack_int* lda, float* work, lapack_int *info );
-void LAPACK_dlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, double* d, lapack_int* mode, double* cond,
- double* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- double* a, lapack_int* lda, double* work,
- lapack_int *info );
-void LAPACK_clatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, float* d, lapack_int* mode, float* cond,
- float* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed,
- char* sym, double* d, lapack_int* mode, double* cond,
- double* dmax, lapack_int* kl, lapack_int* ku, char* pack,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slag2d( lapack_int* m, lapack_int* n, const float* sa,
- lapack_int* ldsa, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dlag2s( lapack_int* m, lapack_int* n, const double* a,
- lapack_int* lda, float* sa, lapack_int* ldsa,
- lapack_int *info );
-void LAPACK_clag2z( lapack_int* m, lapack_int* n,
- const lapack_complex_float* sa, lapack_int* ldsa,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_zlag2c( lapack_int* m, lapack_int* n,
- const lapack_complex_double* a, lapack_int* lda,
- lapack_complex_float* sa, lapack_int* ldsa,
- lapack_int *info );
-void LAPACK_slauum( char* uplo, lapack_int* n, float* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_dlauum( char* uplo, lapack_int* n, double* a, lapack_int* lda,
- lapack_int *info );
-void LAPACK_clauum( char* uplo, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_zlauum( char* uplo, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_int *info );
-void LAPACK_slagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* d, float* a, lapack_int* lda,
- lapack_int* iseed, float* work, lapack_int *info );
-void LAPACK_dlagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* d, double* a, lapack_int* lda,
- lapack_int* iseed, double* work, lapack_int *info );
-void LAPACK_clagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const float* d, lapack_complex_float* a,
- lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlagge( lapack_int* m, lapack_int* n, lapack_int* kl,
- lapack_int* ku, const double* d, lapack_complex_double* a,
- lapack_int* lda, lapack_int* iseed,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_slaset( char* uplo, lapack_int* m, lapack_int* n, float* alpha,
- float* beta, float* a, lapack_int* lda );
-void LAPACK_dlaset( char* uplo, lapack_int* m, lapack_int* n, double* alpha,
- double* beta, double* a, lapack_int* lda );
-void LAPACK_claset( char* uplo, lapack_int* m, lapack_int* n,
- lapack_complex_float* alpha, lapack_complex_float* beta,
- lapack_complex_float* a, lapack_int* lda );
-void LAPACK_zlaset( char* uplo, lapack_int* m, lapack_int* n,
- lapack_complex_double* alpha, lapack_complex_double* beta,
- lapack_complex_double* a, lapack_int* lda );
-void LAPACK_slasrt( char* id, lapack_int* n, float* d, lapack_int *info );
-void LAPACK_dlasrt( char* id, lapack_int* n, double* d, lapack_int *info );
-void LAPACK_claghe( lapack_int* n, lapack_int* k, const float* d,
- lapack_complex_float* a, lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlaghe( lapack_int* n, lapack_int* k, const double* d,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int* iseed, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_slagsy( lapack_int* n, lapack_int* k, const float* d, float* a,
- lapack_int* lda, lapack_int* iseed, float* work,
- lapack_int *info );
-void LAPACK_dlagsy( lapack_int* n, lapack_int* k, const double* d, double* a,
- lapack_int* lda, lapack_int* iseed, double* work,
- lapack_int *info );
-void LAPACK_clagsy( lapack_int* n, lapack_int* k, const float* d,
- lapack_complex_float* a, lapack_int* lda, lapack_int* iseed,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zlagsy( lapack_int* n, lapack_int* k, const double* d,
- lapack_complex_double* a, lapack_int* lda,
- lapack_int* iseed, lapack_complex_double* work,
- lapack_int *info );
-void LAPACK_slapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- float* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_dlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- double* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_clapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- lapack_complex_float* x, lapack_int* ldx, lapack_int* k );
-void LAPACK_zlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n,
- lapack_complex_double* x, lapack_int* ldx, lapack_int* k );
-float LAPACK_slapy2( float* x, float* y );
-double LAPACK_dlapy2( double* x, double* y );
-float LAPACK_slapy3( float* x, float* y, float* z );
-double LAPACK_dlapy3( double* x, double* y, double* z );
-void LAPACK_slartgp( float* f, float* g, float* cs, float* sn, float* r );
-void LAPACK_dlartgp( double* f, double* g, double* cs, double* sn, double* r );
-void LAPACK_slartgs( float* x, float* y, float* sigma, float* cs, float* sn );
-void LAPACK_dlartgs( double* x, double* y, double* sigma, double* cs,
- double* sn );
-// LAPACK 3.3.0
-void LAPACK_cbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* theta, float* phi,
- lapack_complex_float* u1, lapack_int* ldu1,
- lapack_complex_float* u2, lapack_int* ldu2,
- lapack_complex_float* v1t, lapack_int* ldv1t,
- lapack_complex_float* v2t, lapack_int* ldv2t,
- float* b11d, float* b11e, float* b12d,
- float* b12e, float* b21d, float* b21e,
- float* b22d, float* b22e, float* rwork,
- lapack_int* lrwork , lapack_int *info );
-void LAPACK_cheswapr( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_chetri2( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_chetri2x( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* nb , lapack_int *info );
-void LAPACK_chetrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_csyconv( char* uplo, char* way,
- lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_csyswapr( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_csytri2( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_csytri2x( char* uplo, lapack_int* n,
- lapack_complex_float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* nb , lapack_int *info );
-void LAPACK_csytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const lapack_complex_float* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work , lapack_int *info );
-void LAPACK_cunbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- lapack_complex_float* x11, lapack_int* ldx11,
- lapack_complex_float* x12, lapack_int* ldx12,
- lapack_complex_float* x21, lapack_int* ldx21,
- lapack_complex_float* x22, lapack_int* ldx22,
- float* theta, float* phi,
- lapack_complex_float* taup1,
- lapack_complex_float* taup2,
- lapack_complex_float* tauq1,
- lapack_complex_float* tauq2,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_cuncsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, lapack_complex_float* x11,
- lapack_int* ldx11, lapack_complex_float* x12,
- lapack_int* ldx12, lapack_complex_float* x21,
- lapack_int* ldx21, lapack_complex_float* x22,
- lapack_int* ldx22, float* theta,
- lapack_complex_float* u1, lapack_int* ldu1,
- lapack_complex_float* u2, lapack_int* ldu2,
- lapack_complex_float* v1t, lapack_int* ldv1t,
- lapack_complex_float* v2t, lapack_int* ldv2t,
- lapack_complex_float* work, lapack_int* lwork,
- float* rwork, lapack_int* lrwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_dbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* theta, double* phi, double* u1,
- lapack_int* ldu1, double* u2, lapack_int* ldu2,
- double* v1t, lapack_int* ldv1t, double* v2t,
- lapack_int* ldv2t, double* b11d, double* b11e,
- double* b12d, double* b12e, double* b21d,
- double* b21e, double* b22d, double* b22e,
- double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_dorbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* x11, lapack_int* ldx11, double* x12,
- lapack_int* ldx12, double* x21, lapack_int* ldx21,
- double* x22, lapack_int* ldx22, double* theta,
- double* phi, double* taup1, double* taup2,
- double* tauq1, double* tauq2, double* work,
- lapack_int* lwork , lapack_int *info );
-void LAPACK_dorcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, double* x11, lapack_int* ldx11,
- double* x12, lapack_int* ldx12, double* x21,
- lapack_int* ldx21, double* x22, lapack_int* ldx22,
- double* theta, double* u1, lapack_int* ldu1,
- double* u2, lapack_int* ldu2, double* v1t,
- lapack_int* ldv1t, double* v2t, lapack_int* ldv2t,
- double* work, lapack_int* lwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_dsyconv( char* uplo, char* way,
- lapack_int* n, double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work , lapack_int *info );
-void LAPACK_dsyswapr( char* uplo, lapack_int* n,
- double* a, lapack_int* i1, lapack_int* i2 );
-void LAPACK_dsytri2( char* uplo, lapack_int* n,
- double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_dsytri2x( char* uplo, lapack_int* n,
- double* a, lapack_int* lda,
- const lapack_int* ipiv, double* work,
- lapack_int* nb , lapack_int *info );
-void LAPACK_dsytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const double* a,
- lapack_int* lda, const lapack_int* ipiv,
- double* b, lapack_int* ldb, double* work , lapack_int *info );
-void LAPACK_sbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* theta, float* phi, float* u1,
- lapack_int* ldu1, float* u2, lapack_int* ldu2,
- float* v1t, lapack_int* ldv1t, float* v2t,
- lapack_int* ldv2t, float* b11d, float* b11e,
- float* b12d, float* b12e, float* b21d,
- float* b21e, float* b22d, float* b22e,
- float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_sorbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- float* x11, lapack_int* ldx11, float* x12,
- lapack_int* ldx12, float* x21, lapack_int* ldx21,
- float* x22, lapack_int* ldx22, float* theta,
- float* phi, float* taup1, float* taup2,
- float* tauq1, float* tauq2, float* work,
- lapack_int* lwork , lapack_int *info );
-void LAPACK_sorcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, float* x11, lapack_int* ldx11,
- float* x12, lapack_int* ldx12, float* x21,
- lapack_int* ldx21, float* x22, lapack_int* ldx22,
- float* theta, float* u1, lapack_int* ldu1,
- float* u2, lapack_int* ldu2, float* v1t,
- lapack_int* ldv1t, float* v2t, lapack_int* ldv2t,
- float* work, lapack_int* lwork,
- lapack_int* iwork , lapack_int *info );
-void LAPACK_ssyconv( char* uplo, char* way,
- lapack_int* n, float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work , lapack_int *info );
-void LAPACK_ssyswapr( char* uplo, lapack_int* n,
- float* a, lapack_int* i1, lapack_int* i2 );
-void LAPACK_ssytri2( char* uplo, lapack_int* n,
- float* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_float* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_ssytri2x( char* uplo, lapack_int* n,
- float* a, lapack_int* lda,
- const lapack_int* ipiv, float* work,
- lapack_int* nb , lapack_int *info );
-void LAPACK_ssytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs, const float* a,
- lapack_int* lda, const lapack_int* ipiv,
- float* b, lapack_int* ldb, float* work , lapack_int *info );
-void LAPACK_zbbcsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- lapack_int* m, lapack_int* p, lapack_int* q,
- double* theta, double* phi,
- lapack_complex_double* u1, lapack_int* ldu1,
- lapack_complex_double* u2, lapack_int* ldu2,
- lapack_complex_double* v1t, lapack_int* ldv1t,
- lapack_complex_double* v2t, lapack_int* ldv2t,
- double* b11d, double* b11e, double* b12d,
- double* b12e, double* b21d, double* b21e,
- double* b22d, double* b22e, double* rwork,
- lapack_int* lrwork , lapack_int *info );
-void LAPACK_zheswapr( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_zhetri2( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zhetri2x( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* nb , lapack_int *info );
-void LAPACK_zhetrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zsyconv( char* uplo, char* way,
- lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, const lapack_int* ipiv,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zsyswapr( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* i1,
- lapack_int* i2 );
-void LAPACK_zsytri2( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zsytri2x( char* uplo, lapack_int* n,
- lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* work, lapack_int* nb , lapack_int *info );
-void LAPACK_zsytrs2( char* uplo, lapack_int* n,
- lapack_int* nrhs,
- const lapack_complex_double* a, lapack_int* lda,
- const lapack_int* ipiv,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work , lapack_int *info );
-void LAPACK_zunbdb( char* trans, char* signs,
- lapack_int* m, lapack_int* p, lapack_int* q,
- lapack_complex_double* x11, lapack_int* ldx11,
- lapack_complex_double* x12, lapack_int* ldx12,
- lapack_complex_double* x21, lapack_int* ldx21,
- lapack_complex_double* x22, lapack_int* ldx22,
- double* theta, double* phi,
- lapack_complex_double* taup1,
- lapack_complex_double* taup2,
- lapack_complex_double* tauq1,
- lapack_complex_double* tauq2,
- lapack_complex_double* work, lapack_int* lwork , lapack_int *info );
-void LAPACK_zuncsd( char* jobu1, char* jobu2,
- char* jobv1t, char* jobv2t, char* trans,
- char* signs, lapack_int* m, lapack_int* p,
- lapack_int* q, lapack_complex_double* x11,
- lapack_int* ldx11, lapack_complex_double* x12,
- lapack_int* ldx12, lapack_complex_double* x21,
- lapack_int* ldx21, lapack_complex_double* x22,
- lapack_int* ldx22, double* theta,
- lapack_complex_double* u1, lapack_int* ldu1,
- lapack_complex_double* u2, lapack_int* ldu2,
- lapack_complex_double* v1t, lapack_int* ldv1t,
- lapack_complex_double* v2t, lapack_int* ldv2t,
- lapack_complex_double* work, lapack_int* lwork,
- double* rwork, lapack_int* lrwork,
- lapack_int* iwork , lapack_int *info );
-// LAPACK 3.4.0
-void LAPACK_sgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb, const float* v,
- lapack_int* ldv, const float* t, lapack_int* ldt, float* c,
- lapack_int* ldc, float* work, lapack_int *info );
-void LAPACK_dgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb, const double* v,
- lapack_int* ldv, const double* t, lapack_int* ldt,
- double* c, lapack_int* ldc, double* work,
- lapack_int *info );
-void LAPACK_cgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* c, lapack_int* ldc,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* nb,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* c, lapack_int* ldc,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_sgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, float* a,
- lapack_int* lda, float* t, lapack_int* ldt, float* work,
- lapack_int *info );
-void LAPACK_dgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, double* a,
- lapack_int* lda, double* t, lapack_int* ldt, double* work,
- lapack_int *info );
-void LAPACK_cgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_zgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_sgeqrt2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_dgeqrt2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_cgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_zgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_sgeqrt3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda,
- float* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_dgeqrt3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
- double* t, lapack_int* ldt, lapack_int *info );
-void LAPACK_cgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_float* a,
- lapack_int* lda, lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_zgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_double* a,
- lapack_int* lda, lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_stpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const float* v, lapack_int* ldv, const float* t,
- lapack_int* ldt, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, float* work, lapack_int *info );
-void LAPACK_dtpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, double* work, lapack_int *info );
-void LAPACK_ctpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_ztpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n,
- lapack_int* k, lapack_int* l, lapack_int* nb,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_dtpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- double* a, lapack_int* lda, double* b, lapack_int* ldb,
- double* t, lapack_int* ldt, double* work,
- lapack_int *info );
-void LAPACK_ctpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* work, lapack_int *info );
-void LAPACK_ztpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* work, lapack_int *info );
-void LAPACK_stpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- float* a, lapack_int* lda,
- float* b, lapack_int* ldb,
- float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_dtpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- double* a, lapack_int* lda,
- double* b, lapack_int* ldb,
- double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_ctpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- lapack_complex_float* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_ztpqrt2( lapack_int* m, lapack_int* n, lapack_int* l,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- lapack_complex_double* t, lapack_int* ldt,
- lapack_int *info );
-void LAPACK_stprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const float* v, lapack_int* ldv, const float* t,
- lapack_int* ldt, float* a, lapack_int* lda, float* b,
- lapack_int* ldb, const float* work,
- lapack_int* ldwork );
-void LAPACK_dtprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const double* v, lapack_int* ldv, const double* t,
- lapack_int* ldt, double* a, lapack_int* lda, double* b,
- lapack_int* ldb, const double* work,
- lapack_int* ldwork );
-void LAPACK_ctprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const lapack_complex_float* v, lapack_int* ldv,
- const lapack_complex_float* t, lapack_int* ldt,
- lapack_complex_float* a, lapack_int* lda,
- lapack_complex_float* b, lapack_int* ldb,
- const float* work, lapack_int* ldwork );
-void LAPACK_ztprfb( char* side, char* trans, char* direct, char* storev,
- lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l,
- const lapack_complex_double* v, lapack_int* ldv,
- const lapack_complex_double* t, lapack_int* ldt,
- lapack_complex_double* a, lapack_int* lda,
- lapack_complex_double* b, lapack_int* ldb,
- const double* work, lapack_int* ldwork );
-// LAPACK 3.X.X
-void LAPACK_csyr( char* uplo, lapack_int* n, lapack_complex_float* alpha,
- const lapack_complex_float* x, lapack_int* incx,
- lapack_complex_float* a, lapack_int* lda );
-void LAPACK_zsyr( char* uplo, lapack_int* n, lapack_complex_double* alpha,
- const lapack_complex_double* x, lapack_int* incx,
- lapack_complex_double* a, lapack_int* lda );
-void LAPACK_ilaver( const lapack_int* vers_major, const lapack_int* vers_minor,
- const lapack_int* vers_patch );
-
-#ifdef __cplusplus
-}
-#endif /* __cplusplus */
-
-#endif /* _LAPACKE_H_ */
diff --git a/include/ldsubs.h b/include/ldsubs.h
index f1d66bd..91bda01 100644
--- a/include/ldsubs.h
+++ b/include/ldsubs.h
@@ -1,28 +1,38 @@
+typedef struct
+{
+ double S0;
+ double S1;
+ double S2;
+ double S11;
+ double S12;
+ double S22;
+ double m1;
+ double m2;
+ double v11;
+ double v12;
+ double v22;
+ double corr;
+ double Z;
+} CORR;
-typedef struct {
- double S0 ;
- double S1 ;
- double S2 ;
- double S11 ;
- double S12 ;
- double S22 ;
- double m1 ;
- double m2 ;
- double v11 ;
- double v12 ;
- double v22 ;
- double corr ;
- double Z ;
-} CORR;
+int
+calccorr (CORR *corrpt, int mode, int ztrans);
+void
+printcorr (CORR *corrpt);
+void
+clearcorr (CORR *corrpt);
+void
+addcorr (CORR *corrpt, double x1, double x2);
+void
+addcorrn (CORR *corrpt, double x1, double x2, double yn);
+void
+minuscorr (CORR *out, CORR *c1, CORR *c2);
-int calccorr(CORR *corrpt, int mode, int ztrans) ;
-void printcorr(CORR *corrpt) ;
-void clearcorr(CORR *corrpt) ;
-void addcorr(CORR *corrpt, double x1, double x2) ;
-void addcorrn(CORR *corrpt, double x1, double x2, double yn) ;
-void minuscorr(CORR *out, CORR *c1, CORR *c2) ;
-
-double lddip(double *xc) ;
-double zdip(double *xc) ;
-void setzdipmode(int mode) ;
-void setzdphasedmode(int mode) ;
+double
+lddip (double *xc);
+double
+zdip (double *xc);
+void
+setzdipmode (int mode);
+void
+setzdphasedmode (int mode);
diff --git a/include/linsubs.h b/include/linsubs.h
index 39715cb..de2dd89 100644
--- a/include/linsubs.h
+++ b/include/linsubs.h
@@ -3,18 +3,28 @@
#include <unistd.h>
#include <math.h>
-void bal(double *a, double *b, int n) ;
+void
+bal (double *a, double *b, int n);
/* linear algebra */
-void mulmat(double *a, double *b, double *c, int a1, int a2, int a3) ;
-int solvit (double *prod, double *rhs,int n, double *ans);
-double pdinv(double *cinv, double *coeff, int n) ;
+void
+mulmat (double *a, double *b, double *c, int a1, int a2, int a3);
+int
+solvit (double *prod, double *rhs, int n, double *ans);
+double
+pdinv (double *cinv, double *coeff, int n);
/* numer recipes p 97 */
-int choldc (double *a, int n, double p[]);
-void cholsl (double *a, int n, double p[], double b[], double x[]);
-void cholesky(double *cf, double *a, int n) ;
-void pmat(double *mat, int n) ;
-void imulmat(int *a, int *b, int *c, int a1, int a2, int a3) ;
-int linsolv(int n, double* pfMatr, double* pfVect, double* sol) ; // Developer: Henry Guennadi Levkin
+int
+choldc (double *a, int n, double p[]);
+void
+cholsl (double *a, int n, double p[], double b[], double x[]);
+void
+cholesky (double *cf, double *a, int n);
+void
+pmat (double *mat, int n);
+void
+imulmat (int *a, int *b, int *c, int a1, int a2, int a3);
+int
+linsolv (int n, double* pfMatr, double* pfVect, double* sol); // Developer: Henry Guennadi Levkin
diff --git a/include/mcio.h b/include/mcio.h
index 401c1d8..ee73b65 100644
--- a/include/mcio.h
+++ b/include/mcio.h
@@ -20,164 +20,251 @@
#define GDISMUL 1000000
// multiplier for gdis to make integer for sort
-enum outputmodetype {
-ANCESTRYMAP,
-EIGENSTRAT,
-PED,
-PACKEDPED,
-PACKEDANCESTRYMAP } ;
+enum outputmodetype
+{
+ ANCESTRYMAP, EIGENSTRAT, PED, PACKEDPED, PACKEDANCESTRYMAP
+};
-
-typedef struct {
+typedef struct
+{
char ID[IDSIZE];
- double gpos ;
- double ppos ;
- int chrom ;
- char cchrom[6] ;
- int nn[4] ;
- int ignore ;
- int isrfake ;
- char alleles[2] ;
- int inputrow ;
- int cuptnum ;
- int chimpfudge ;
-} SNPDATA ;
-
-
-int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing) ;
-double nextmesh(double val, double spacing) ;
-double interp (double l, double r, double x, double al, double ar) ;
-
-int
-loadsnps(SNP **snpm, SNPDATA **snpraw,
- int *snpindx, int nreal, double spacing, int *numignore) ;
-
-int readsnpdata(SNPDATA **snpraw, char *fname) ;
-int readinddata(Indiv **indivmarkers, char *fname) ;
-int readindpeddata(Indiv **indivmarkers, char *fname) ;
-void pedname(char *name, char *sx0, char *sx1) ;
-
-int readtldata(Indiv **indivmarkers, int numind, char *fname) ;
-int readindval(Indiv **indivmarkers, int numind, char *fname) ;
-int readfreqdata(SNP **snpm, int numsnps, char *fname) ;
-void clearsnp(SNP *cupt) ;
-int rmindivs(SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs) ;
-int rmsnps(SNP **snpm, int numsnps, char *deletesnpoutname) ;
-void clearind(Indiv **indm, int numind) ;
-void cleartg(Indiv **indm, int nind) ;
-
-double mknn(int *nn, int n0, int n1) ;
-void clearsnpord() ;
-int getsnps(char *snpfname, SNP ***snpmarkpt, double spacing,
- char *badsnpname, int *nignore, int numrisks) ;
-int getsizex(char *fname) ;
-int getindivs(char *indivfname, Indiv ***indmarkpt) ;
-
-int setstatus(Indiv **indm, int numindivs, char *smatch) ;
-int setstatusv(Indiv **indm, int numindivs, char *smatch, int val) ;
-
-long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) ;
-void getgenos_list(char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) ;
-void printsnps(char *snpoutfilename, SNP **snpm, int num,
- Indiv **indm, int printfake, int printvalids) ;
-int checkxval(SNP *cupt, Indiv *indx, int val) ;
-void printdata(char *genooutfilename, char *indoutfilename,
- SNP **snpm, Indiv **indiv, int numsnps,int numind, int packmode);
-int readgdata(Indiv **indivmarkers, int numind, char *gname) ;
-int numvalidind(Indiv **indivmarkers, int numind) ;
-int numvalidgtind(SNP **snpm, int numsnps, int ind) ;
-int numvalidgt(Indiv **indivmarkers, SNP *cupt) ;
-int numvalidgtx(Indiv **indivmarkers, SNP *cupt, int affst) ;
-int getweights(char *fname, SNP **snpm, int numsnps) ;
-void outpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) ;
-int ispack(char *gname) ;
-int iseigenstrat(char *gname) ;
-void inpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) ;
-int inpack2(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) ;
-int ineigenstrat(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) ;
-void setepath(SNP **snpm, int n) ;
-void clearepath(char *xpack) ;
-long bigread(int fdes, char *packg, long numbytes) ;
+ double gpos;
+ double ppos;
+ int chrom;
+ char cchrom[6];
+ int nn[4];
+ int ignore;
+ int isrfake;
+ char alleles[2];
+ int inputrow;
+ int cuptnum;
+ int chimpfudge;
+} SNPDATA;
-// pedfile support
-int getpedgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) ;
-void genopedcnt(char *genoname, int **gcounts, int nsnp) ;
+int
+numfakes (SNPDATA **snpraw, int *snpindx, int nreal, double spacing);
+double
+nextmesh (double val, double spacing);
+double
+interp (double l, double r, double x, double al, double ar);
+
+int
+loadsnps (SNP **snpm, SNPDATA **snpraw, int *snpindx, int nreal, double spacing,
+ int *numignore);
+
+int
+readsnpdata (SNPDATA **snpraw, char *fname);
+int
+readinddata (Indiv **indivmarkers, char *fname);
+int
+readindpeddata (Indiv **indivmarkers, char *fname);
+void
+pedname (char *name, char *sx0, char *sx1);
+
+int
+readtldata (Indiv **indivmarkers, int numind, char *fname);
+int
+readindval (Indiv **indivmarkers, int numind, char *fname);
+int
+readfreqdata (SNP **snpm, int numsnps, char *fname);
+void
+clearsnp (SNP *cupt);
+int
+rmindivs (SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs);
+int
+rmsnps (SNP **snpm, int numsnps, char *deletesnpoutname);
+void
+clearind (Indiv **indm, int numind);
+void
+cleartg (Indiv **indm, int nind);
+
+double
+mknn (int *nn, int n0, int n1);
+void
+clearsnpord ();
+int
+getsnps (char *snpfname, SNP ***snpmarkpt, double spacing, char *badsnpname,
+ int *nignore, int numrisks);
+int
+getsizex (char *fname);
+int
+getindivs (char *indivfname, Indiv ***indmarkpt);
+
+int
+setstatus (Indiv **indm, int numindivs, char *smatch);
+int
+setstatusv (Indiv **indm, int numindivs, char *smatch, int val);
+
+long
+getgenos (char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs, int nignore);
+void
+getgenos_list (char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers,
+ int numsnps, int numindivs, int nignore);
+void
+printsnps (char *snpoutfilename, SNP **snpm, int num, Indiv **indm,
+ int printfake, int printvalids);
+int
+checkxval (SNP *cupt, Indiv *indx, int val);
+void
+printdata (char *genooutfilename, char *indoutfilename, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind, int packmode);
+int
+readgdata (Indiv **indivmarkers, int numind, char *gname);
+int
+numvalidind (Indiv **indivmarkers, int numind);
+int
+numvalidgtind (SNP **snpm, int numsnps, int ind);
+int
+numvalidgt (Indiv **indivmarkers, SNP *cupt);
+int
+numvalidgtx (Indiv **indivmarkers, SNP *cupt, int affst);
+int
+getweights (char *fname, SNP **snpm, int numsnps);
+void
+outpack (char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps,
+ int numind);
+int
+ispack (char *gname);
+int
+iseigenstrat (char *gname);
+void
+inpack (char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps,
+ int numind);
+int
+inpack2 (char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps,
+ int numind);
+int
+ineigenstrat (char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps,
+ int numind);
+void
+setepath (SNP **snpm, int n);
+void
+clearepath (char *xpack);
+long
+bigread (int fdes, char *packg, long numbytes);
-int pedval(char *sx) ;
-int xpedval(char c) ;
-int ptoachrom(char *ss) ;
+// pedfile support
+int
+getpedgenos (char *genoname, SNP **snpmarkers, Indiv **indivmarkers,
+ int numsnps, int numindivs, int nignore);
+void
+genopedcnt (char *genoname, int **gcounts, int nsnp);
-void setgref(int **gcounts, int nsnp, int *gvar, int *gref) ;
-void cleargdata(SNP **snpmarkers, int numsnps, int numindivs) ;
-void setgenotypename(char **gname, char *iname) ;
-void settersemode(int mode) ;
+int
+pedval (char *sx);
+int
+xpedval (char c);
+int
+ptoachrom (char *ss);
-void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname) ;
-int snprawindex(SNPDATA **snpraw, int nreal, char *sname) ;
-int readsnpmapdata(SNPDATA **snpraw, char *fname) ;
-int checkfake(char *ss) ;
-void setbadpedignore() ;
-int setsdpos( SNPDATA *sdpt, int pos) ;
+void
+setgref (int **gcounts, int nsnp, int *gvar, int *gref);
+void
+cleargdata (SNP **snpmarkers, int numsnps, int numindivs);
+void
+setgenotypename (char **gname, char *iname);
+void
+settersemode (int mode);
void
-outeigenstrat(char *snpname, char *indname, char *gname,
-SNP **snpm, Indiv **indiv, int numsnps, int numind) ;
+dobadsnps (SNPDATA **snpraw, int nreal, char *badsnpname);
+int
+snprawindex (SNPDATA **snpraw, int nreal, char *sname);
+int
+readsnpmapdata (SNPDATA **snpraw, char *fname);
+int
+checkfake (char *ss);
+void
+setbadpedignore ();
+int
+setsdpos (SNPDATA *sdpt, int pos);
void
-outped(char *snpname, char *indname, char *gname,
-SNP **snpm, Indiv **indiv, int numsnps, int numind, int ogmode) ;
+outeigenstrat (char *snpname, char *indname, char *gname, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind);
void
-outpackped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode) ;
+outped (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numind, int ogmode);
-void setbedbuff(char *buff, int *gtypes, int numind) ;
-int bedval(int g) ;
-int str2chrom(char *ss) ;
+void
+outpackped (char *snpname, char *indname, char *gname, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind, int ogmode);
-void outindped(char *indname, Indiv **indiv, int numind, int ogmode) ;
+void
+setbedbuff (char *buff, int *gtypes, int numind);
+int
+bedval (int g);
+int
+str2chrom (char *ss);
void
-printmap(char *snpname, SNP **snpm, int numsnps, Indiv **indiv) ;
+outindped (char *indname, Indiv **indiv, int numind, int ogmode);
-int maxlinelength(char *fname) ;
-int checksize(int numindivs, int numsnps, enum outputmodetype outputmode) ;
+void
+printmap (char *snpname, SNP **snpm, int numsnps, Indiv **indiv);
-void setomode(enum outputmodetype *outmode, char *omode) ;
+int
+maxlinelength (char *fname);
+int
+checksize (int numindivs, int numsnps, enum outputmodetype outputmode);
void
-outfiles(char *snpname, char *indname, char *gname, SNP **snpm,
- Indiv **indiv, int numsnps, int numind, int packem, int ogmode) ;
+setomode (enum outputmodetype *outmode, char *omode);
-void snpdecimate(SNP **snpm, int nsnp, int decim, int mindis, int maxdis) ;
-void decimate(SNP **cbuff, int n, int decim, int mindis, int maxdis) ;
-int vvadjust(double *cc, int n, double *pmean) ;
-int killhir2(SNP **snpm, int numsnps, int numind, double physlim, double genlim, double rhothresh) ;
-void freecupt(SNP **cupt) ;
-void freeped() ;
-void cntpops(int *count, Indiv **indm, int numindivs, char **eglist, int numeg) ;
-void printalleles(SNP *cupt, FILE *fff) ;
-char *getpackgenos() ;
-void clearpackgenos() ;
-void setchr(int mode) ;
-void setchimpmode(int mode) ;
+void
+outfiles (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numind, int packem, int ogmode);
-int genoopenit(genofile **gfile, char *geno2name, SNP **snp2m,
- Indiv **indiv2m, int numsnp2, int numindiv2, int nignore) ;
-int genoreadit(genofile *gfile, SNP **pcupt) ;
-void genocloseit(genofile *gfile) ;
+void
+snpdecimate (SNP **snpm, int nsnp, int decim, int mindis, int maxdis);
+void
+decimate (SNP **cbuff, int n, int decim, int mindis, int maxdis);
+int
+vvadjust (double *cc, int n, double *pmean);
+int
+killhir2 (SNP **snpm, int numsnps, int numind, double physlim, double genlim,
+ double rhothresh);
+void
+freecupt (SNP **cupt);
+void
+freeped ();
+void
+cntpops (int *count, Indiv **indm, int numindivs, char **eglist, int numeg);
+void
+printalleles (SNP *cupt, FILE *fff);
+char *
+getpackgenos ();
+void
+clearpackgenos ();
+void
+setchr (int mode);
+void
+setchimpmode (int mode);
-void putped(int num) ;
-void getped(int num) ;
+int
+genoopenit (genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m,
+ int numsnp2, int numindiv2, int nignore);
+int
+genoreadit (genofile *gfile, SNP **pcupt);
+void
+genocloseit (genofile *gfile);
-void logdeletedsnp(char *snpname, char *cmnt, char *deletesnpoutname);
-void sortsnps(SNP **snpa, SNP **snpb, int n) ;
-void setpordercheck (int mode) ;
-void putsnpordered(int mode) ;
-int getsnpordered() ;
+void
+putped (int num);
+void
+getped (int num);
+void
+logdeletedsnp (char *snpname, char *cmnt, char *deletesnpoutname);
+void
+sortsnps (SNP **snpa, SNP **snpb, int n);
+void
+setpordercheck (int mode);
+void
+putsnpordered (int mode);
+int
+getsnpordered ();
#endif
diff --git a/include/mcmcpars.h b/include/mcmcpars.h
index 750ef13..e62ed2e 100644
--- a/include/mcmcpars.h
+++ b/include/mcmcpars.h
@@ -1,38 +1,37 @@
-
- double thp1=1.0, thp2 = 5.0 ; /* params for theta */
- double thxp1=1.0, thxp2 = 10.0 ; /* params for theta X */
- double thxp0 = 40 ; /* cross term */
+double thp1 = 1.0, thp2 = 5.0; /* params for theta */
+double thxp1 = 1.0, thxp2 = 10.0; /* params for theta X */
+double thxp0 = 40; /* cross term */
/* -1 is default value (=0 logically) */
-
- double lp1 = 10.2, lp2 = 2 ;
- double lxp1 = 10.2, lxp2 = 2 ;
- double priorlmean = 6 ;
- double priorlmsig = 5 ;
+double lp1 = 10.2, lp2 = 2;
+double lxp1 = 10.2, lxp2 = 2;
+
+double priorlmean = 6;
+double priorlmsig = 5;
/* hyperprior on mean, s.dev for gamma prior on lambda */
- double qtrbase = 0.0 ;
+double qtrbase = 0.0;
- double loclip = -20.0 ;
- double hiclip = 15.0 ;
+double loclip = -20.0;
+double hiclip = 15.0;
- double a1 = 2, b1= 8 ;
- double aa2 = 2, bb2 = 14, cc2 = 85 ;
- double p1 = 18, psi1 = 3 ;
+double a1 = 2, b1 = 8;
+double aa2 = 2, bb2 = 14, cc2 = 85;
+double p1 = 18, psi1 = 3;
/* for toys */
- double muval = 0.0, tmumean = 0.2, muval1 ;
+double muval = 0.0, tmumean = 0.2, muval1;
/* for bridge sampler */
- int pubxindiv = -1 ;
- int alkesmode = NO ;
- int malexhet = NO ;
- int familynames = YES ;
+int pubxindiv = -1;
+int alkesmode = NO;
+int malexhet = NO;
+int familynames = YES;
- int decim = 0 , dmindis = 200000, dmaxdis = 500000 ; // decimation parameters
- int hashcheck = YES ;
- int outputall = NO ;
- int sevencolumnped = NO ;
+int decim = 0, dmindis = 200000, dmaxdis = 500000; // decimation parameters
+int hashcheck = YES;
+int outputall = NO;
+int sevencolumnped = NO;
- FILE *fstdetails = NULL;
+FILE *fstdetails = NULL;
diff --git a/include/not-thread-h b/include/not-thread-h
deleted file mode 100644
index 0c9bde2..0000000
--- a/include/not-thread-h
+++ /dev/null
@@ -1,49 +0,0 @@
-#ifndef _THREAD_
-#define _THREAD_
-
-#include <admutils.h>
-
-// globals defined in smartpca.c
-extern int ldregress;
-extern int minallelecnt;
-extern int maxmissing;
-extern int numthreads;
-extern double ldlimit;
-
-extern pthread_mutex_t mutex_xtx;
-extern pthread_mutex_t mutex_nkill;
-
-
-typedef struct thread_args {
-
- int mythreadnum;
-
- SNP **xsnplist;
- double *xmean;
- double *xfancy;
- int *xindex;
- int *xtypes;
-
- int numindivs;
- int nrows;
- int ncols;
- int blocksize;
- int weightmode;
-
- int nkill; // out
- int nused; // out
-
- double *XTX;
-
-} thread_args_t;
-
-
-void *thread_function(void *args);
-
-thread_args_t *pack_args(int mythreadnum, SNP **xsnplist, double *xmean, double *xfancy, int *xindex, int *xtypes, double *XTX,
- int numindivs, int nrows, int ncols, int blocksize, int weightmode);
-
-void unpack_args(thread_args_t *ta, int *nkill, int *nused);
-
-#endif
-
diff --git a/include/old.h b/include/old.h
deleted file mode 100644
index 1e4de5a..0000000
--- a/include/old.h
+++ /dev/null
@@ -1,43 +0,0 @@
-#include<math.h>
-#include<stdlib.h>
-
-
-#include <values.h>
-
-#define BIGINT MAXINT
-#define SRAND srandom
-#define LRAND random
-#define DRAND() ( (double) (random() % BIGINT) / (double) (BIGINT))
-#define DRAND2() ( drand2() )
-/* random must return random integer in range 0 to BIGINT-1 */
-
-
-#define NORMAL gauss
-
-
-
-double gauss() ;
-void gaussa(double *a, int n) ;
-double gds(double a) ;
-double poidev(double mean) ;
-double ranpoiss(double mean) ;
-double ranpoissx(double mean) ;
-void ranperm(int *a, int n) ;
-
-double ranexp( void) ;
-double rangam(double a) ;
-int randis(double *a, int n) ;
-void ransamp(int *samp, int nsamp, double *p, int plen) ;
-void pick2(int n, int *k1, int *k2) ;
-int ranmod(int n) ;
-double ranbeta(double a, double b) ;
-int ranbinom(int n, double p) ;
-void ewens(int *a, int n, double theta) ;
-void genmultgauss(double *rvec, int num, int n, double *covar) ;
-double drand2() ;
-void ranmultinom(int *samp, int n, double *p, int len) ;
-double ranchi (int d) ;
-double raninvwis(double *wis, int t, int d, double *s) ;
-double uniform(double lo, double hi) ;
-void randirichlet(double *x, double *pp, int n) ;
-void randirmult(double *pp, int *aa, int len, int m) ;
diff --git a/include/packit.h b/include/packit.h
index 31f377e..8364602 100644
--- a/include/packit.h
+++ b/include/packit.h
@@ -1,7 +1,7 @@
-int packmode = NO ;
-unsigned char *packgenos = NULL ;
-long packlen = 0 ;
-long rlen = -1 ;
-int rdismode = NO ;
-unsigned char *packepath ;
+int packmode = NO;
+unsigned char *packgenos = NULL;
+long packlen = 0;
+long rlen = -1;
+int rdismode = NO;
+unsigned char *packepath;
diff --git a/include/qpsubs.h b/include/qpsubs.h
index 2d6cb86..40a1264 100644
--- a/include/qpsubs.h
+++ b/include/qpsubs.h
@@ -16,185 +16,288 @@
#include "regsubs.h"
#include "egsubs.h"
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+int
+loadsnpx (SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+vadjust (double *rr, int n, double *pmean);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolx (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+void
+getrawcol (int *rawcol, SNP *cupt, int *xindex, int nrows);
+void
+getrawcolx (int **ccc, SNP *cupt, int *xindex, int nrows, Indiv **indm);
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-int loadsnpx(SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int vadjust(double *rr, int n, double *pmean) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolx(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-void getrawcol(int *rawcol, SNP *cupt, int *xindex, int nrows) ;
-void getrawcolx(int **ccc, SNP *cupt, int *xindex, int nrows, Indiv **indm) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+void
+setmiss (SNP **snpm, int numsnps);
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
-double dofst(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int mode) ;
+double
+dofst (double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int mode);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double divcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+divcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double fst(SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int type1, int type2, double *psd, int mode) ;
+double
+fst (SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols, int type1,
+ int type2, double *psd, int mode);
-double dofstx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg) ;
+double
+dofstx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg);
-void fstcolinb(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg) ;
+void
+fstcolinb (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int numeg);
-void fstcolyy(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg) ;
+void
+fstcolyy (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int numeg);
-double fstcoly(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcoly (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double fstx(SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int type1, int type2, double *psd) ;
+double
+fstx (SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols, int type1,
+ int type2, double *psd);
void
- setplimit(Indiv **indivmarkers, int numindivs,
- char **eglist, int numeg, int plimit) ;
+setplimit (Indiv **indivmarkers, int numindivs, char **eglist, int numeg,
+ int plimit);
-void loadzdata(double **zdata, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *ncolx, int *tagnums) ;
+void
+loadzdata (double **zdata, SNP **xsnplist, int *xindex, int *xtypes, int nrows,
+ int ncols, int numeg, int *ncolx, int *tagnums);
-void getpdata(int *rawcol, double *pm, double *pn, int *xtypes, int nrows, int numeg) ;
+void
+getpdata (int *rawcol, double *pm, double *pn, int *xtypes, int nrows,
+ int numeg);
-void getrscore(double *rscore, double *rho, double **zz,
- int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks) ;
+void
+getrscore (double *rscore, double *rho, double **zz, int ncols, int a, int b,
+ int c, int d, int numeg, int *blabels, int nblocks);
-double qcorr(double **zz, double *rho,
- int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks) ;
-void xcopy(int rp[4], int a , int b, int c, int d) ;
-void settsc(int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3]) ;
-void printsc(int pat[3][4], double tscore[3], char **eglist, double ymin) ;
-double dohzg(double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg) ;
+double
+qcorr (double **zz, double *rho, int ncols, int a, int b, int c, int d,
+ int numeg, int *blabels, int nblocks);
+void
+xcopy (int rp[4], int a, int b, int c, int d);
+void
+settsc (int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3]);
+void
+printsc (int pat[3][4], double tscore[3], char **eglist, double ymin);
+double
+dohzg (double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg);
-void dohzgjack(double *fstest, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *bcols, int nblocks) ;
+void
+dohzgjack (double *fstest, double *fstsig, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, int *bcols,
+ int nblocks);
-void gethscore(double *hscore, double *scores,
- int a, int b, int c, int d, int numeg) ;
+void
+gethscore (double *hscore, double *scores, int a, int b, int c, int d,
+ int numeg);
-double qhdiff(double *scores, int a, int b, int c, int d, int numeg) ;
-void setblocks(int *block, int *bsize, int *nblock, SNP **snpm, int numsnps, double blocklen) ;
-int numblocks(SNP **snpm, int numsnps, double blocklen) ;
-void setmgpos(SNP **snpm, int numsnps, double *maxgdis) ;
-void setgfromp(SNP **snpm, int numsnps) ;
-void wjackest(double *est, double *sig, double mean, double *jmean, double *jwt, int n) ;
-void wjackvest(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g) ;
-void corrwjack(double *xrho, double *xsig, double *z1, double *z2, int n, int *bcols, int nblocks);
-double crho(double *stats) ;
+double
+qhdiff (double *scores, int a, int b, int c, int d, int numeg);
+void
+setblocks (int *block, int *bsize, int *nblock, SNP **snpm, int numsnps,
+ double blocklen);
+int
+numblocks (SNP **snpm, int numsnps, double blocklen);
+void
+setmgpos (SNP **snpm, int numsnps, double *maxgdis);
+void
+setgfromp (SNP **snpm, int numsnps);
+void
+wjackest (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int n);
+void
+wjackvest (double *vest, double *var, int d, double *mean, double **jmean,
+ double *jwt, int g);
+void
+corrwjack (double *xrho, double *xsig, double *z1, double *z2, int n,
+ int *bcols, int nblocks);
+double
+crho (double *stats);
-void ndfst5(double *zzest, double *zzsig, double **zn, double **zd, int ncols, int *bcols, int nblocks) ;
-void regestit(double *ans, double *xn, double *xd) ;
+void
+ndfst5 (double *zzest, double *zzsig, double **zn, double **zd, int ncols,
+ int *bcols, int nblocks);
+void
+regestit (double *ans, double *xn, double *xd);
-void setwt(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
- int *xindex, int *xtypes, char * outpop, char **eglist, int numeg) ;
-void countg(int *rawcol, int **cc, int *xtypes, int n, int ntypes) ;
-void dohzgjack(double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *bcols, int nblocks) ;
+void
+setwt (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
+ int *xindex, int *xtypes, char * outpop, char **eglist, int numeg);
+void
+countg (int *rawcol, int **cc, int *xtypes, int n, int ntypes);
+void
+dohzgjack (double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int *bcols, int nblocks);
-void setbcols(SNP **xsnplist, int ncols, int *bcols) ;
+void
+setbcols (SNP **xsnplist, int ncols, int *bcols);
double
-dofstnum(double *fst, double *fstnum, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks) ;
+dofstnum (double *fst, double *fstnum, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks);
-double doinbreed(double *inb, double *inbest, double *inbsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, Indiv **indivmarkers) ;
+double
+doinbreed (double *inb, double *inbest, double *inbsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, Indiv **indivmarkers);
double
-dofstnumx(double *fst, double *fstnum, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, Indiv **indm, int fstmode) ;
+dofstnumx (double *fst, double *fstnum, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, Indiv **indm, int fstmode);
void
-dof3(double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode) ;
+dof3 (double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode);
void
-dof4(double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode) ;
+dof4 (double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode);
-void f3y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+void
+f3y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3);
-void f4y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4) ;
+void
+f4y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3, int type4);
-void f3sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+void
+f3sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3);
-void f2sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3) ;
+void
+f2sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3);
-void f4yx(double *estn, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4) ;
+void
+f4yx (double *estn, SNP *cupt, Indiv **indm, int *xindex, int *xtypes,
+ int nrows, int type1, int type2, int type3, int type4);
-void f3yy(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg) ;
+void
+f3yy (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows, int numeg);
-int f3yyx(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg, Indiv **indm) ;
+int
+f3yyx (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows,
+ int numeg, Indiv **indm);
-void countpops(int ***counts, SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols) ;
+void
+countpops (int ***counts, SNP **xsnplist, int *xindex, int *xtypes, int nrows,
+ int ncols);
-double doadmlin(double *jest, double *jsig, double *zlin, double *var,
- SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, Indiv **indm) ;
+double
+doadmlin (double *jest, double *jsig, double *zlin, double *var, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, double scale, Indiv **indm);
-double estmix(double *z, double *f3, int n) ;
+double
+estmix (double *z, double *f3, int n);
-void bump2(double *x, int a, int b, int n, double val) ;
-double dump2(double *x, int a, int b, int n) ;
-void bump3(double *x, int a, int b, int c, int n, double val) ;
-double dump3(double *x, int a, int b, int c, int n) ;
+void
+bump2 (double *x, int a, int b, int n, double val);
+double
+dump2 (double *x, int a, int b, int n);
+void
+bump3 (double *x, int a, int b, int c, int n, double val);
+double
+dump3 (double *x, int a, int b, int c, int n);
-void bump4(double *x, int a, int b, int c, int d, int n, double val) ;
-void bump4x(double *x, int a, int b, int c, int d, int n, double val) ; // all 4 images
-void set4x(double *x, int a, int b, int c, int d, int n, double val) ;
-void set4(double *x, int a, int b, int c, int d, int n, double val) ; // all 4 images
+void
+bump4 (double *x, int a, int b, int c, int d, int n, double val);
+void
+bump4x (double *x, int a, int b, int c, int d, int n, double val); // all 4 images
+void
+set4x (double *x, int a, int b, int c, int d, int n, double val);
+void
+set4 (double *x, int a, int b, int c, int d, int n, double val); // all 4 images
-double dump4(double *x, int a, int b, int c, int d, int n) ;
-double ff3val(double *ff3, int a, int b, int c, int n) ;
+double
+dump4 (double *x, int a, int b, int c, int d, int n);
+double
+ff3val (double *ff3, int a, int b, int c, int n);
// graph stuff
-int loadgraph(char *readit, char ***peglist) ;
-void getgmix(double **vmix, int *lmix, int *nmix) ;
-void putgmix(double **vmix) ;
-void getpwts(double *pwts, int *nrows, int *nedge) ;
-void getenames(char **enames) ;
-void setsimp(double *ww, int n) ;
-int edgenum(char *edgename) ;
-void addvertex(char *vertname) ;
-void supergetvnames(char **vnames, int *xvlist, int nxvlist) ;
-void superalloc(int **xv, int ***xe, int ***adv, int **aedge) ;
-void supersetup(int *xvlist, int *nxvlist, int **xelist, int *nxelist, int **admixv, int *admixedge, int *nxalist) ;
-void supereglist(int *eelist) ;
-void supergetvar(double *svar,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superputvals(double **admixw, double *elen,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superest(double *xmean, double *xvar, double *svar, double *yobs, int nxvlist, int *elist) ;
-void supergetvals(double **admixw, double *elen,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void superreest(double *s2,
- int *xvlist, int nxvlist, int **xelist, int nxelist, int **admixv, int *admixedge, int nxalist) ;
-void setadmfix(char *fixname) ;
-void setinbreed(int val) ;
+int
+loadgraph (char *readit, char ***peglist);
+void
+getgmix (double **vmix, int *lmix, int *nmix);
+void
+putgmix (double **vmix);
+void
+getpwts (double *pwts, int *nrows, int *nedge);
+void
+getenames (char **enames);
+void
+setsimp (double *ww, int n);
+int
+edgenum (char *edgename);
+void
+addvertex (char *vertname);
+void
+supergetvnames (char **vnames, int *xvlist, int nxvlist);
+void
+superalloc (int **xv, int ***xe, int ***adv, int **aedge);
+void
+supersetup (int *xvlist, int *nxvlist, int **xelist, int *nxelist, int **admixv,
+ int *admixedge, int *nxalist);
+void
+supereglist (int *eelist);
+void
+supergetvar (double *svar, int *xvlist, int nxvlist, int **xelist, int nxelist,
+ int **admixv, int *admixedge, int nxalist);
+void
+superputvals (double **admixw, double *elen, int *xvlist, int nxvlist,
+ int **xelist, int nxelist, int **admixv, int *admixedge,
+ int nxalist);
+void
+superest (double *xmean, double *xvar, double *svar, double *yobs, int nxvlist,
+ int *elist);
+void
+supergetvals (double **admixw, double *elen, int *xvlist, int nxvlist,
+ int **xelist, int nxelist, int **admixv, int *admixedge,
+ int nxalist);
+void
+superreest (double *s2, int *xvlist, int nxvlist, int **xelist, int nxelist,
+ int **admixv, int *admixedge, int nxalist);
+void
+setadmfix (char *fixname);
+void
+setinbreed (int val);
diff --git a/include/ranmath.h b/include/ranmath.h
index 6e0a8d8..671cb46 100644
--- a/include/ranmath.h
+++ b/include/ranmath.h
@@ -1,7 +1,6 @@
#include<math.h>
#include<stdlib.h>
-
#include <limits.h>
#define BIGINT INT_MAX
@@ -11,35 +10,63 @@
#define DRAND2() ( drand2() )
/* random must return random integer in range 0 to BIGINT-1 */
-
#define NORMAL gauss
-double gauss() ; // standard normal
-void gaussa(double *a, int n) ; // array of standard normals
-double gds(double a) ; // obsolete
-double poidev(double mean) ; // obsolete
-double ranpoiss(double mean) ; // poisson Note double
-double ranpoissx(double mean) ; // poisson | > 0
-void ranperm(int *a, int n) ; // randomly permute a; if random permulation wanted : idperm(a,n) ; ranperm(a,n)
-double ranexp( void) ; // exponential mean 1
-double rangam(double a) ; // standard gamma mean a
-int randis(double *a, int n) ; // element from discrete distribution a
-void ransamp(int *samp, int nsamp, double *p, int plen) ; // sample nsamp samples from p
-void pick2(int n, int *k1, int *k2) ; // pick 2 elements from 0..n-1
-int ranmod(int n) ; // random mod n
-double ranbeta(double a, double b) ; // beta
-int ranbinom(int n, double p) ; // binomial
-int ewens(int *a, int n, double theta) ; // ewens sampling formula
-void genmultgauss(double *rvec, int num, int n, double *covar) ; // multivariate
-double drand2() ;
-void ranmultinom(int *samp, int n, double *p, int len) ; // multinomial
-double ranchi (int d) ; // chisq d dof.
-double raninvwis(double *wis, int t, int d, double *s) ; // inverse wishart
-double uniform(double lo, double hi) ; // uniform (lo..hi)
-void randirichlet(double *x, double *pp, int n) ; // dirichlet parameter vector pp
-void randirmult(double *pp, int *aa, int len, int m) ; // dirichlet multinomial. Output aa
-int prob1(double p) ;
-double rant(double df) ; // t distribution
-double samppow(double e, double a, double b) ;
-double rantruncnorm(double T, int upper) ; // sample standard normal > T (upper =1) < T (upper = 0)
-int ranhprob(int n, int a, int m) ;
+double
+gauss (); // standard normal
+void
+gaussa (double *a, int n); // array of standard normals
+double
+gds (double a); // obsolete
+double
+poidev (double mean); // obsolete
+double
+ranpoiss (double mean); // poisson Note double
+double
+ranpoissx (double mean); // poisson | > 0
+void
+ranperm (int *a, int n); // randomly permute a; if random permulation wanted : idperm(a,n) ; ranperm(a,n)
+double
+ranexp (void); // exponential mean 1
+double
+rangam (double a); // standard gamma mean a
+int
+randis (double *a, int n); // element from discrete distribution a
+void
+ransamp (int *samp, int nsamp, double *p, int plen); // sample nsamp samples from p
+void
+pick2 (int n, int *k1, int *k2); // pick 2 elements from 0..n-1
+int
+ranmod (int n); // random mod n
+double
+ranbeta (double a, double b); // beta
+int
+ranbinom (int n, double p); // binomial
+int
+ewens (int *a, int n, double theta); // ewens sampling formula
+void
+genmultgauss (double *rvec, int num, int n, double *covar); // multivariate
+double
+drand2 ();
+void
+ranmultinom (int *samp, int n, double *p, int len); // multinomial
+double
+ranchi (int d); // chisq d dof.
+double
+raninvwis (double *wis, int t, int d, double *s); // inverse wishart
+double
+uniform (double lo, double hi); // uniform (lo..hi)
+void
+randirichlet (double *x, double *pp, int n); // dirichlet parameter vector pp
+void
+randirmult (double *pp, int *aa, int len, int m); // dirichlet multinomial. Output aa
+int
+prob1 (double p);
+double
+rant (double df); // t distribution
+double
+samppow (double e, double a, double b);
+double
+rantruncnorm (double T, int upper); // sample standard normal > T (upper =1) < T (upper = 0)
+int
+ranhprob (int n, int a, int m);
diff --git a/include/regsubs.h b/include/regsubs.h
index 0f6f93b..c809757 100644
--- a/include/regsubs.h
+++ b/include/regsubs.h
@@ -4,24 +4,32 @@
#include <math.h>
#include <nicklib.h>
-double regressit(double *ans, double *eq, double *rhs, int m, int n) ;
-void regressitall(char **vname, double *eq, double *rhs, int m, int n) ;
-void add1(int *a, int *b, int n) ;
+double
+regressit (double *ans, double *eq, double *rhs, int m, int n);
+void
+regressitall (char **vname, double *eq, double *rhs, int m, int n);
+void
+add1 (int *a, int *b, int n);
-void ptoz(double *p, double *z, int n) ;
-void ztop(double *p, double *z, int n) ;
-double logregressit(double *ans, double *eq, double **rhs, int neq, int nv) ;
-double logrscore(double *eq, double **rhs, int neq, int nv) ;
+void
+ptoz (double *p, double *z, int n);
+void
+ztop (double *p, double *z, int n);
+double
+logregressit (double *ans, double *eq, double **rhs, int neq, int nv);
+double
+logrscore (double *eq, double **rhs, int neq, int nv);
-void calcgh(double *grad, double *hess, double *eq, double *z,
- double *n0, double *n1, int neq, int nv) ;
+void
+calcgh (double *grad, double *hess, double *eq, double *z, double *n0,
+ double *n1, int neq, int nv);
-double zlike(double *eq, double *n0, double *n1,
- double *ans, int neq, int nv) ;
+double
+zlike (double *eq, double *n0, double *n1, double *ans, int neq, int nv);
-void squish(double *xmat, double *mat, int nrow, int oldc, int newc) ;
+void
+squish (double *xmat, double *mat, int nrow, int oldc, int newc);
void
-calcres(double *res, double *ans, double *eq, double *rhs,
- int neq, int nv) ;
+calcres (double *res, double *ans, double *eq, double *rhs, int neq, int nv);
diff --git a/include/smartsubs.h b/include/smartsubs.h
index ae015be..7dd432e 100644
--- a/include/smartsubs.h
+++ b/include/smartsubs.h
@@ -1,5 +1,6 @@
-void setoutliermode(int mode) ;
+void
+setoutliermode (int mode);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
diff --git a/include/sortit.h b/include/sortit.h
index 60b5287..1a85375 100644
--- a/include/sortit.h
+++ b/include/sortit.h
@@ -1,13 +1,23 @@
-
-void sortit(double *a, int *ind, int len) ;
-double median (double *a, int n) ;
-int compit (int *a1, int *a2) ;
-void isortit(int *a, int *ind, int len) ;
-int icompit (int *a1, int *a2) ;
-void invperm(int *a, int *b, int n) ;
-int ipcompit (int *a1, int *a2) ;
-int compiarr(int *a, int *b, int len) ;
-void ipsortit(int **a, int *ind, int len, int rlen) ;
-void ipsortitp(int **a, int *ind, int len, int rlen, int *pp) ;
-void setorder (int *pp, int rlen) ;
+void
+sortit (double *a, int *ind, int len);
+double
+median (double *a, int n);
+int
+compit (int *a1, int *a2);
+void
+isortit (int *a, int *ind, int len);
+int
+icompit (int *a1, int *a2);
+void
+invperm (int *a, int *b, int n);
+int
+ipcompit (int *a1, int *a2);
+int
+compiarr (int *a, int *b, int len);
+void
+ipsortit (int **a, int *ind, int len, int rlen);
+void
+ipsortitp (int **a, int *ind, int len, int rlen, int *pp);
+void
+setorder (int *pp, int rlen);
diff --git a/include/statsubs.h b/include/statsubs.h
index a893c5e..e5cce87 100644
--- a/include/statsubs.h
+++ b/include/statsubs.h
@@ -14,83 +14,151 @@
#define ex(x) (((x) < -BIGX) ? 0.0 : exp (x))
#define SQRT_PI (1.0/I_SQRT_PI) /* sqrt (pi) */
-double medchi(int *cls, int len, int *n0, int *n1, double *kstail) ;
-double ks2(int *cls, int len, int *n0, int *n1, double *kstail) ;
-double probks(double lam) ;
-
-double nordis(double z) ;
-double ndens(double val, double mean, double sig) ;
-double ntail(double z) ;
-double zprob(double p) ;
-void setzptable() ;
-double z2x2(double *a) ;
-double conchi(double *a, int m, int n) ;
-double conchiv(double *a, int m, int n) ;
-double chitest(double *a, double *p, int n) ;
-
-double xlgamma(double x) ;
-double psi(double x) ;
-double tau(double x) ;
-double logbessi0(double x) ;
-double bessi0(double x) ;
-double logbessi1(double x) ;
-double bessi1(double x) ;
-void bernload() ;
-double bernum(int x) ;
-
-void mleg(double a1, double a2, double *p, double *lam) ;
-
-double dilog(double x) ;
-double li2(double x) ;
-
-double hwstat(double *x) ;
-
-double gammprob(double x, double p, double lam) ;
-double bprob(double p, double a, double b) ;
-double lbeta(double a, double b) ;
-double dirmult(double *pp, int *aa, int len) ;
-double dawson(double t) ;
-
-double binomtail(int n, int t, double p, char c) ;
-double binlogtail(int n, int t, double p, char c) ;
-void genbin(double *a, int n, double p) ;
-void genlogbin(double *a, int n, double p) ;
-int ifirstgt(int val, int *tab, int n) ;
-int firstgt(double val, double *tab, int n) ;
-
-void cinterp(double val, double x0, double x1,
- double f0, double f0p, double f1, double f1p, double *fv, double *fvp) ;
-int firstgtx(double val, double *tab, int n) ;
-int jfirstgtx(int val, int *tab, int n) ;
-
-double rtlchsq(int df, double z) ;
-double critchi(int df, double z) ;
-double rtlf(int df1, int df2, double f) ;
-
-double ltlg(double a, double x) ;
-double rtlg(double a, double x) ;
-
-double twdens(double twstat) ;
-double twtail(double twstat) ;
-double twtailx(double twstat) ;
-double twdensx(double twstat) ;
-double twnorm(double lam, double p, double n) ;
-void twfree() ;
-int settwxtable(char *table) ;
-void gettw(double x, double *tailp, double *densp) ;
-double dotwcalc(double *lambda, int m, double *ptw, double *pzn, double *pzvar, int minm) ;
-int numgtz(double *a, int n) ;
-
-double betaix(double a, double b, double lo, double hi) ;
-double betai(double a, double b, double x) ;
-void bpars(double *a, double *b, double mean, double var) ;
-void bmoments(double a, double b, double *mean, double *var) ;
-double unbiasedest(int *ndx, int ndsize, int **counts) ;
-void weightjack(double *est, double *sig, double mean, double *jmean, double *jwt, int g) ;
-int modehprob(int n, int a, int m) ;
-void calcfc(double *c, int n, double rho) ;
-void circconv(double *xout, double *xa, double *xb, int n) ;
-
-double bino(int a, int b) ;
-void setbino(int maxbco) ;
-void destroy_bino() ;
+double
+medchi (int *cls, int len, int *n0, int *n1, double *kstail);
+double
+ks2 (int *cls, int len, int *n0, int *n1, double *kstail);
+double
+probks (double lam);
+
+double
+nordis (double z);
+double
+ndens (double val, double mean, double sig);
+double
+ntail (double z);
+double
+zprob (double p);
+void
+setzptable ();
+double
+z2x2 (double *a);
+double
+conchi (double *a, int m, int n);
+double
+conchiv (double *a, int m, int n);
+double
+chitest (double *a, double *p, int n);
+
+double
+xlgamma (double x);
+double
+psi (double x);
+double
+tau (double x);
+double
+logbessi0 (double x);
+double
+bessi0 (double x);
+double
+logbessi1 (double x);
+double
+bessi1 (double x);
+void
+bernload ();
+double
+bernum (int x);
+
+void
+mleg (double a1, double a2, double *p, double *lam);
+
+double
+dilog (double x);
+double
+li2 (double x);
+
+double
+hwstat (double *x);
+
+double
+gammprob (double x, double p, double lam);
+double
+bprob (double p, double a, double b);
+double
+lbeta (double a, double b);
+double
+dirmult (double *pp, int *aa, int len);
+double
+dawson (double t);
+
+double
+binomtail (int n, int t, double p, char c);
+double
+binlogtail (int n, int t, double p, char c);
+void
+genbin (double *a, int n, double p);
+void
+genlogbin (double *a, int n, double p);
+int
+ifirstgt (int val, int *tab, int n);
+int
+firstgt (double val, double *tab, int n);
+
+void
+cinterp (double val, double x0, double x1, double f0, double f0p, double f1,
+ double f1p, double *fv, double *fvp);
+int
+firstgtx (double val, double *tab, int n);
+int
+jfirstgtx (int val, int *tab, int n);
+
+double
+rtlchsq (int df, double z);
+double
+critchi (int df, double z);
+double
+rtlf (int df1, int df2, double f);
+
+double
+ltlg (double a, double x);
+double
+rtlg (double a, double x);
+
+double
+twdens (double twstat);
+double
+twtail (double twstat);
+double
+twtailx (double twstat);
+double
+twdensx (double twstat);
+double
+twnorm (double lam, double p, double n);
+void
+twfree ();
+int
+settwxtable (char *table);
+void
+gettw (double x, double *tailp, double *densp);
+double
+dotwcalc (double *lambda, int m, double *ptw, double *pzn, double *pzvar,
+ int minm);
+int
+numgtz (double *a, int n);
+
+double
+betaix (double a, double b, double lo, double hi);
+double
+betai (double a, double b, double x);
+void
+bpars (double *a, double *b, double mean, double var);
+void
+bmoments (double a, double b, double *mean, double *var);
+double
+unbiasedest (int *ndx, int ndsize, int **counts);
+void
+weightjack (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g);
+int
+modehprob (int n, int a, int m);
+void
+calcfc (double *c, int n, double rho);
+void
+circconv (double *xout, double *xa, double *xb, int n);
+
+double
+bino (int a, int b);
+void
+setbino (int maxbco);
+void
+destroy_bino ();
diff --git a/include/strsubs.h b/include/strsubs.h
index f246ee9..697cda2 100644
--- a/include/strsubs.h
+++ b/include/strsubs.h
@@ -1,74 +1,139 @@
#include <stdlib.h>
-int splitup (char *strin, char *strpt[],int maxpt) ;
-int splitupx(char *strin, char **spt, int maxpt, char splitc) ;
-int splitupwxbuff(char *strin, char **spt, int maxpt, char *bigbuff, int bigbufflen) ;
-int splitupxbuff(char *strin, char **spt, int maxpt, char splitc, char *bigbuff, int bigbufflen) ;
-int oldsplitup (char *strin, char *strpt[],int maxpt) ;
-void freeup (char *strpt[],int numpt) ;
-int split1 (char *strin, char *strpt[], char splitc);
-int first_word(char *string, char *word, char *rest) ;
-char *fnwhite (char *ss) ;
-char *fwhite (char *ss) ;
-char *ftab (char *ss) ;
-int NPisnumber (char c) ;
-int isnumword (char *str) ;
-void fatalx( char *fmt, ...) ;
-long seednum() ;
-void printbl(int n) ;
-void printnl() ;
-void striptrail(char *sss, char c) ;
-void catx(char *sout, char **spt, int n) ;
-void catxx(char *sout, char **spt, int n) ;
-void catxc(char *sout, char **spt, int n, char c) ;
-void makedfn(char *dirname, char *fname, char *outname, int maxstr) ;
-int substring (char **ap, char *inx, char *outx) ;
-int numcols (char *name) ;
-int numlines(char *name) ;
-void openit(char *name, FILE **fff, char *type) ;
-int ftest(char *aname) ;
-int getxx(double **xx, int maxrow, int numcol, char *fname) ;
-int getss(char **ss, char *fname) ;
-double clocktime() ; // cpu time in seconds
-void crevcomp(char *sout, char *sin) ;
-int indxstring(char **namelist, int len, char *strid) ;
-int indxstringr(char **namelist, int len, char *strid) ;
-char *strstrx(char *s1, char *s2) ; // case insensitive strstr
-int getxxnames(char ***pnames, double **xx, int maxrow, int numcol, char *fname);
-int getjjnames(char ***pnames, int **xx, int maxrow, int numcol, char *fname);
-int getxxnamesf(char ***pnames, double **xx, int maxrow, int numcol, FILE *fff) ;
-int getnameslohi(char ****pnames, int maxrow, int numcol, char *fname, int lo, int hi) ;
-int getnames(char ****pnames, int maxrow, int numcol, char *fname) ;
-char num2iub (int num) ;
-char revchar(char c) ;
-int iub2num(char c) ;
-char num2base (int num) ;
-int base2num(char c) ;
-char *int_string(int a, int len, int base) ;
-char *binary_string(int a, int len) ;
-int string_binary(char *sx) ;
-void freestring (char **ss) ;
-void copystrings(char **sa, char **sb, int n) ;
-void printstringsw(char **ss, int n, int slen, int width) ;
-void printstrings(char **ss, int n) ;
-int ridfile(char *fname) ;
-char compbase(char x) ;
-void mkupper(char *sx) ;
-void mklower(char *sx) ;
-int iubdekode(char *a, char iub) ;
-int isiub(char iub) ;
-int isiub2(char iub) ;
-int iubcbases(char *cbases, char iub) ;
-int ishet(char c) ;
-int char2int(char cc) ;
-char int2char(int x) ;
-void chomp(char *str) ;
-
-int numcmatch(char *cc, int len, char c) ;
-int numcnomatch(char *cc, int len, char c) ;
-
-
+int
+splitup (char *strin, char *strpt[], int maxpt);
+int
+splitupx (char *strin, char **spt, int maxpt, char splitc);
+int
+splitupwxbuff (char *strin, char **spt, int maxpt, char *bigbuff,
+ int bigbufflen);
+int
+splitupxbuff (char *strin, char **spt, int maxpt, char splitc, char *bigbuff,
+ int bigbufflen);
+int
+oldsplitup (char *strin, char *strpt[], int maxpt);
+void
+freeup (char *strpt[], int numpt);
+int
+split1 (char *strin, char *strpt[], char splitc);
+int
+first_word (char *string, char *word, char *rest);
+char *
+fnwhite (char *ss);
+char *
+fwhite (char *ss);
+char *
+ftab (char *ss);
+int
+NPisnumber (char c);
+int
+isnumword (char *str);
+void
+fatalx (char *fmt, ...);
+long
+seednum ();
+void
+printbl (int n);
+void
+printnl ();
+void
+striptrail (char *sss, char c);
+void
+catx (char *sout, char **spt, int n);
+void
+catxx (char *sout, char **spt, int n);
+void
+catxc (char *sout, char **spt, int n, char c);
+void
+makedfn (char *dirname, char *fname, char *outname, int maxstr);
+int
+substring (char **ap, char *inx, char *outx);
+int
+numcols (char *name);
+int
+numlines (char *name);
+void
+openit (char *name, FILE **fff, char *type);
+int
+ftest (char *aname);
+int
+getxx (double **xx, int maxrow, int numcol, char *fname);
+int
+getss (char **ss, char *fname);
+double
+clocktime (); // cpu time in seconds
+void
+crevcomp (char *sout, char *sin);
+int
+indxstring (char **namelist, int len, char *strid);
+int
+indxstringr (char **namelist, int len, char *strid);
+char *
+strstrx (char *s1, char *s2); // case insensitive strstr
+int
+getxxnames (char ***pnames, double **xx, int maxrow, int numcol, char *fname);
+int
+getjjnames (char ***pnames, int **xx, int maxrow, int numcol, char *fname);
+int
+getxxnamesf (char ***pnames, double **xx, int maxrow, int numcol, FILE *fff);
+int
+getnameslohi (char ****pnames, int maxrow, int numcol, char *fname, int lo,
+ int hi);
+int
+getnames (char ****pnames, int maxrow, int numcol, char *fname);
+char
+num2iub (int num);
+char
+revchar (char c);
+int
+iub2num (char c);
+char
+num2base (int num);
+int
+base2num (char c);
+char *
+int_string (int a, int len, int base);
+char *
+binary_string (int a, int len);
+int
+string_binary (char *sx);
+void
+freestring (char **ss);
+void
+copystrings (char **sa, char **sb, int n);
+void
+printstringsw (char **ss, int n, int slen, int width);
+void
+printstrings (char **ss, int n);
+int
+ridfile (char *fname);
+char
+compbase (char x);
+void
+mkupper (char *sx);
+void
+mklower (char *sx);
+int
+iubdekode (char *a, char iub);
+int
+isiub (char iub);
+int
+isiub2 (char iub);
+int
+iubcbases (char *cbases, char iub);
+int
+ishet (char c);
+int
+char2int (char cc);
+char
+int2char (int x);
+void
+chomp (char *str);
+int
+numcmatch (char *cc, int len, char c);
+int
+numcnomatch (char *cc, int len, char c);
#define ZALLOC(item,n,type) if ((item = (type *)calloc((n),sizeof(type))) == NULL) \
fatalx("Unable to allocate %d unit(s) for item \n",n)
diff --git a/include/twtable.h b/include/twtable.h
new file mode 100644
index 0000000..628c885
--- /dev/null
+++ b/include/twtable.h
@@ -0,0 +1,12 @@
+/**
+ * @file twtable.h
+ * @brief Tracy-Widom distribution
+ */
+
+#ifndef INCLUDE_TWTABLE_H_
+
+extern const double TWXVAL[], TWXTAIL[], TWXPDF[];
+extern const int TWTABSIZE;
+
+#endif /* INCLUDE_TWTABLE_H_ */
+#define INCLUDE_TWTABLE_H_
diff --git a/include/vsubs.h b/include/vsubs.h
index 8d35812..993aa0f 100644
--- a/include/vsubs.h
+++ b/include/vsubs.h
@@ -4,177 +4,327 @@
#include <math.h>
#include "strsubs.h"
-void vsp(double *a, double *b, double c, int n);
-void vst(double *a, double *b, double c, int n);
-void vvt(double *a, double *b, double *c, int n);
-void vvp(double *a, double *b, double *c, int n);
-void vvm(double *a, double *b, double *c, int n);
-void vvd(double *a, double *b, double *c, int n);
-void vsqrt(double *a, double *b, int n) ;
-void vinvert(double *a, double *b, int n) ;
-void vabs(double *a, double *b, int n) ;
-void vlog(double *a, double *b, int n) ;
-void vlog2(double *a, double *b, int n) ;
-void vexp(double *a, double *b, int n) ;
-void vclear(double *a, double c, int n) ;
-void vzero(double *a, int n) ;
-void cpzero(char **a, int n) ;
-void ivvp(int *a, int *b, int *c, int n);
-void ivvm(int *a, int *b, int *c, int n);
-void ivsp(int *a, int *b, int c, int n);
-void ivst(int *a, int *b, int c, int n);
-void ivclear(int *a, int c, long n) ;
-void lvclear(long *a, long c, long n) ;
-void ivzero(int *a, int n) ;
-void cclear(unsigned char *a, unsigned char c, long n) ;
-
-double clip(double x, double lo, double hi) ;
-void ivclip(int *a, int *b,int loval, int hival,int n) ;
-void vclip(double *a, double *b,double loval, double hival,int n) ;
-
-void vmaxmin(double *a, int n, double *max, double *min) ;
-void vlmaxmin(double *a, int n, int *max, int *min) ;
-void ivmaxmin(int *a, int n, int *max, int *min) ;
-int minivec(int *a, int n) ;
-int maxivec(int *a, int n) ;
-void ivlmaxmin(int *a, int n, int *max, int *min) ;
-void getdiag(double *a, double *b, int n) ;
-void setdiag(double *a, double *diag, int n) ;
-void flipiarr(int *a, int *b, int n) ;
-void fliparr(double *a, double *b, int n) ;
-int ipow2 (int l) ;
-
-void copyarr(double *a,double *b,int n) ;
-void revarr(double *a, double *b,int n) ;
-void reviarr(int *a,int *b,int n) ;
-void revuiarr(unsigned int *a, unsigned int *b,int n) ;
-void copyiarr(int *a,int *b,int n) ;
-void copyiparr(int **a,int **b,int n) ;
-
-void dpermute(double *a, int *ind, int len) ;
-void ipermute(int *a, int *ind, int len) ;
-void dppermute(double **a, int *ind, int len) ;
-void ippermute(int **a, int *ind, int len) ;
-
-double asum(double *a, int n) ;
-double asum2(double *a, int n) ;
-int intsum(int *a, int n) ;
-long longsum(long *a, int n) ;
-int idot(int *a, int *b, int n) ;
-int iprod(int *a, int n) ;
-double aprod(double *a, int n) ;
-double vdot(double *a, double *b, int n) ;
-double corr(double *a, double *b, int n) ;
-double corrx(double *a, double *b, int n) ;
-double variance(double *a, int n) ;
-double trace(double *a, int n) ;
-int nnint(double a) ;
-void countcat(int *tags, int n,int *ncat,int nclass) ;
-void rowsum(double *a, double *rr, int n) ;
-void colsum(double *a, double *cc, int n) ;
-void rrsum(double *a, double *cc, int m, int n) ;
-void ccsum(double *a, double *cc, int m, int n) ;
-void printmatfile(double *a, int m, int n, FILE *fff) ;
-void printmatwfile(double *a, int m, int n, int w, FILE *fff) ;
-void printmat(double *a, int m, int n) ;
-void printmatw(double *a, int m, int n, int w) ;
-void printmatl(double *a, int m, int n) ;
-void printmatwl(double *a, int m, int n, int w) ;
-void printmatwf(double *a, int m, int n, int w, char *format);
-void int2c(char *cc, int *b, int n) ;
-void floatit(double *a, int *b, int n) ;
-void fixit(int *a, double *b, int n) ;
-void rndit(double *a, double *b, int n) ;
-void printimatw(int *a, int m, int n, int w) ;
-void printimatx(int *a, int m, int n) ;
-void printimat(int *a, int m, int n) ;
-void printimatl(int *a, int m, int n) ;
-void printimatlfile(int *a, int m, int n, FILE *fff) ;
-void printimatfile(int *a, int m, int n, FILE *fff) ;
-void printimatwfile(int *a, int m, int n, int w, FILE *fff) ;
-void printstring(char *ss, int width) ;
-void printstringbasepos(char *ss, int w, int basepos) ;
-void printstringf(char *ss, int width, FILE *fff) ;
-
-int findfirst(int *a, int n, int val) ;
-int findfirstl(long *a, int n, long val) ;
-int findfirstu(unsigned int *a, int n, unsigned int val) ;
-int findlastu(unsigned int *a, int n, unsigned int val) ;
-
-int findlast(int *a, int n, int val) ;
-int binsearch(int *a, int n, int val) ;
-void idperm(int *a, int n) ;
-double NPlog2(double y) ;
-double log2fac(int n) ;
-double logfac(int n) ;
-double logbino(int n, int k) ;
-double loghprob(int n, int a, int m, int k) ;
+void
+vsp (double *a, double *b, double c, int n);
+void
+vst (double *a, double *b, double c, int n);
+void
+vvt (double *a, double *b, double *c, int n);
+void
+vvp (double *a, double *b, double *c, int n);
+void
+vvm (double *a, double *b, double *c, int n);
+void
+vvd (double *a, double *b, double *c, int n);
+void
+vsqrt (double *a, double *b, int n);
+void
+vinvert (double *a, double *b, int n);
+void
+vabs (double *a, double *b, int n);
+void
+vlog (double *a, double *b, int n);
+void
+vlog2 (double *a, double *b, int n);
+void
+vexp (double *a, double *b, int n);
+void
+vclear (double *a, double c, int n);
+void
+vzero (double *a, int n);
+void
+cpzero (char **a, int n);
+void
+ivvp (int *a, int *b, int *c, int n);
+void
+ivvm (int *a, int *b, int *c, int n);
+void
+ivsp (int *a, int *b, int c, int n);
+void
+ivst (int *a, int *b, int c, int n);
+void
+ivclear (int *a, int c, long n);
+void
+lvclear (long *a, long c, long n);
+void
+ivzero (int *a, int n);
+void
+cclear (unsigned char *a, unsigned char c, long n);
+
+double
+clip (double x, double lo, double hi);
+void
+ivclip (int *a, int *b, int loval, int hival, int n);
+void
+vclip (double *a, double *b, double loval, double hival, int n);
+
+void
+vmaxmin (double *a, int n, double *max, double *min);
+void
+vlmaxmin (double *a, int n, int *max, int *min);
+void
+ivmaxmin (int *a, int n, int *max, int *min);
+int
+minivec (int *a, int n);
+int
+maxivec (int *a, int n);
+void
+ivlmaxmin (int *a, int n, int *max, int *min);
+void
+getdiag (double *a, double *b, int n);
+void
+setdiag (double *a, double *diag, int n);
+void
+flipiarr (int *a, int *b, int n);
+void
+fliparr (double *a, double *b, int n);
+int
+ipow2 (int l);
+
+void
+copyarr (double *a, double *b, int n);
+void
+revarr (double *a, double *b, int n);
+void
+reviarr (int *a, int *b, int n);
+void
+revuiarr (unsigned int *a, unsigned int *b, int n);
+void
+copyiarr (int *a, int *b, int n);
+void
+copyiparr (int **a, int **b, int n);
+
+void
+dpermute (double *a, int *ind, int len);
+void
+ipermute (int *a, int *ind, int len);
+void
+dppermute (double **a, int *ind, int len);
+void
+ippermute (int **a, int *ind, int len);
+
+double
+asum (double *a, int n);
+double
+asum2 (double *a, int n);
+int
+intsum (int *a, int n);
+long
+longsum (long *a, int n);
+int
+idot (int *a, int *b, int n);
+int
+iprod (int *a, int n);
+double
+aprod (double *a, int n);
+double
+vdot (double *a, double *b, int n);
+double
+corr (double *a, double *b, int n);
+double
+corrx (double *a, double *b, int n);
+double
+variance (double *a, int n);
+double
+trace (double *a, int n);
+int
+nnint (double a);
+void
+countcat (int *tags, int n, int *ncat, int nclass);
+void
+rowsum (double *a, double *rr, int n);
+void
+colsum (double *a, double *cc, int n);
+void
+rrsum (double *a, double *cc, int m, int n);
+void
+ccsum (double *a, double *cc, int m, int n);
+void
+printmatfile (double *a, int m, int n, FILE *fff);
+void
+printmatwfile (double *a, int m, int n, int w, FILE *fff);
+void
+printmat (double *a, int m, int n);
+void
+printmatw (double *a, int m, int n, int w);
+void
+printmatl (double *a, int m, int n);
+void
+printmatwl (double *a, int m, int n, int w);
+void
+printmatwf (double *a, int m, int n, int w, char *format);
+void
+int2c (char *cc, int *b, int n);
+void
+floatit (double *a, int *b, int n);
+void
+fixit (int *a, double *b, int n);
+void
+rndit (double *a, double *b, int n);
+void
+printimatw (int *a, int m, int n, int w);
+void
+printimatx (int *a, int m, int n);
+void
+printimat (int *a, int m, int n);
+void
+printimatl (int *a, int m, int n);
+void
+printimatlfile (int *a, int m, int n, FILE *fff);
+void
+printimatfile (int *a, int m, int n, FILE *fff);
+void
+printimatwfile (int *a, int m, int n, int w, FILE *fff);
+void
+printstring (char *ss, int width);
+void
+printstringbasepos (char *ss, int w, int basepos);
+void
+printstringf (char *ss, int width, FILE *fff);
+
+int
+findfirst (int *a, int n, int val);
+int
+findfirstl (long *a, int n, long val);
+int
+findfirstu (unsigned int *a, int n, unsigned int val);
+int
+findlastu (unsigned int *a, int n, unsigned int val);
+
+int
+findlast (int *a, int n, int val);
+int
+binsearch (int *a, int n, int val);
+void
+idperm (int *a, int n);
+double
+NPlog2 (double y);
+double
+log2fac (int n);
+double
+logfac (int n);
+double
+logbino (int n, int k);
+double
+loghprob (int n, int a, int m, int k);
/* hypergeometric probability */
-double logmultinom(int *cc, int n) ;
-double addlog(double a, double b) ;
-double vldot(double *x, double *y, int n) ;
-double pow10 (double x) ;
-double vpow10 (double *a, double *b, int n) ;
-double vlog10 (double *a, double *b, int n) ;
+double
+logmultinom (int *cc, int n);
+double
+addlog (double a, double b);
+double
+vldot (double *x, double *y, int n);
+double
+pow10 (double x);
+double
+vpow10 (double *a, double *b, int n);
+double
+vlog10 (double *a, double *b, int n);
/* matrix transpose */
-void transpose(double *aout, double *ain, int m, int n) ;
-void addoutmul(double *out, double *a, double mul, int n) ;
-void addouter(double *out, double *a, int n) ;
-void subouter(double *out, double *a, int n) ;
+void
+transpose (double *aout, double *ain, int m, int n);
+void
+addoutmul (double *out, double *a, double mul, int n);
+void
+addouter (double *out, double *a, int n);
+void
+subouter (double *out, double *a, int n);
/* storage allocation */
-int **initarray_2Dint(int numrows, int numcolumns, int initval);
-long **initarray_2Dlong(int numrows, int numcolumns, int initval);
-void free2Dint(int ***xx, int numrows) ;
-double **initarray_2Ddouble(int numrows, int numcolumns, double initval);
-long double **initarray_2Dlongdouble(int numrows, int numcolumns, long double initval);
-void clear2D(double ***xx, int numrows, int numcols, double val) ;
-void iclear2D(int ***xx, int numrows, int numcols, int val) ;
-void free2D(double ***xx, int numrows) ;
-void free2Dlongdouble(long double ***xx, int numrows) ;
-void free_darray (double **xx) ;
-void free_iarray (int **xx) ;
-
-double bal1 (double *a, int n) ;
-void vcompl(double *a, double *b, int n) ;
-void setidmat(double *a, int n) ;
-
-int stripit(double *a, double *b, int *x, int len) ;
-int istripit(int *a, int *b, int *x, int len) ;
-int cstripit(char **a, char **b, int *x, int len) ;
-
-void mapit(int *a, int *b, int n, int inval, int outval) ;
-int ifall(int n, int k) ; // falling factorial = n (n-1) (n-2) ... (n-k+1)
-double hlife(double val) ;
-void *topheap () ;
-
-void swap (double *pa, double *pb) ;
-void iswap (int *pa, int *pb) ;
-void cswap(char *c1, char *c2) ;
-
-
-void copyarr2D(double **a, double **b, int nrows, int ncols) ; // a input b output
-void copyiarr2D(int **a, int **b, int nrows, int ncols) ; // a input b output
-void plus2Dint(int **a, int **b, int **c, int nrows, int ncols) ;
-void minus2Dint(int **a, int **b, int **c, int nrows, int ncols) ;
-
-void plus2D(double **a, double **b, double **c, int nrows, int ncols) ;
-void minus2D(double **a, double **b, double **c, int nrows, int ncols) ;
-void sum2D(double *a, double **b, int nrows, int ncols) ;
-int total2D(double **a, int nrows, int ncols) ;
-int total2Dint(int **a, int nrows, int ncols) ;
-
-int kodeitb(int *xx, int len, int base) ;
-int dekodeitb(int *xx, int kode, int len, int base) ;
-int kodeitbb(int *xx, int len, int *baselist) ;
-int dekodeitbb(int *xx, int kode, int len, int *baselist) ;
-
-int isprime(long num) ;
-long nextprime(long num) ;
-int irevcomp (int xx, int stringlen) ;
-long lrevcomp (long xx, int stringlen) ;
-void ismatch(int *a, int *b, int n, int val) ;
-int pmult(double *a, double *b, double *c, int na, int nb) ;
-void pdiff(double *a, double *b, int deg) ;
+int **
+initarray_2Dint (int numrows, int numcolumns, int initval);
+long **
+initarray_2Dlong (int numrows, int numcolumns, int initval);
+void
+free2Dint (int ***xx, int numrows);
+double **
+initarray_2Ddouble (int numrows, int numcolumns, double initval);
+long double **
+initarray_2Dlongdouble (int numrows, int numcolumns, long double initval);
+void
+clear2D (double ***xx, int numrows, int numcols, double val);
+void
+iclear2D (int ***xx, int numrows, int numcols, int val);
+void
+free2D (double ***xx, int numrows);
+void
+free2Dlongdouble (long double ***xx, int numrows);
+void
+free_darray (double **xx);
+void
+free_iarray (int **xx);
+
+double
+bal1 (double *a, int n);
+void
+vcompl (double *a, double *b, int n);
+void
+setidmat (double *a, int n);
+
+int
+stripit (double *a, double *b, int *x, int len);
+int
+istripit (int *a, int *b, int *x, int len);
+int
+cstripit (char **a, char **b, int *x, int len);
+
+void
+mapit (int *a, int *b, int n, int inval, int outval);
+int
+ifall (int n, int k); // falling factorial = n (n-1) (n-2) ... (n-k+1)
+double
+hlife (double val);
+void *
+topheap ();
+
+void
+swap (double *pa, double *pb);
+void
+iswap (int *pa, int *pb);
+void
+cswap (char *c1, char *c2);
+
+void
+copyarr2D (double **a, double **b, int nrows, int ncols); // a input b output
+void
+copyiarr2D (int **a, int **b, int nrows, int ncols); // a input b output
+void
+plus2Dint (int **a, int **b, int **c, int nrows, int ncols);
+void
+minus2Dint (int **a, int **b, int **c, int nrows, int ncols);
+
+void
+plus2D (double **a, double **b, double **c, int nrows, int ncols);
+void
+minus2D (double **a, double **b, double **c, int nrows, int ncols);
+void
+sum2D (double *a, double **b, int nrows, int ncols);
+int
+total2D (double **a, int nrows, int ncols);
+int
+total2Dint (int **a, int nrows, int ncols);
+
+int
+kodeitb (int *xx, int len, int base);
+int
+dekodeitb (int *xx, int kode, int len, int base);
+int
+kodeitbb (int *xx, int len, int *baselist);
+int
+dekodeitbb (int *xx, int kode, int len, int *baselist);
+int
+isprime (long num);
+long
+nextprime (long num);
+int
+irevcomp (int xx, int stringlen);
+long
+lrevcomp (long xx, int stringlen);
+void
+ismatch (int *a, int *b, int n, int val);
+int
+pmult (double *a, double *b, double *c, int na, int nb);
+void
+pdiff (double *a, double *b, int deg);
diff --git a/include/workqueue.h b/include/workqueue.h
index fd5680c..7bda5ed 100644
--- a/include/workqueue.h
+++ b/include/workqueue.h
@@ -5,23 +5,30 @@
#include <pthread.h>
#endif
-typedef struct work_task_t {
+typedef struct work_task_t
+{
#ifdef HAVE_PTHREAD
pthread_t thread;
#endif
- void *(*start_routine)(void*);
+ void *
+ (*start_routine) (void*);
void *argument;
} work_task;
-typedef struct work_queue_t {
+typedef struct work_queue_t
+{
// Which tasks are pending?
work_task *tasks;
int num_tasks;
} work_queue;
-void create_work_queue(work_queue **the_queue);
-void destroy_work_queue(work_queue **the_queue);
-void queue_task(work_queue* queue, const work_task* task);
-void wait_for_queue_to_complete(const work_queue *queue);
+void
+create_work_queue (work_queue **the_queue);
+void
+destroy_work_queue (work_queue **the_queue);
+void
+queue_task (work_queue* queue, const work_task* task);
+void
+wait_for_queue_to_complete (const work_queue *queue);
#endif // WORKQUEUE_H
diff --git a/include/xpsubs.h b/include/xpsubs.h
index b83dbd6..ed58f12 100644
--- a/include/xpsubs.h
+++ b/include/xpsubs.h
@@ -2,41 +2,46 @@
#include <math.h>
#include "admutils.h"
-extern int verbose ;
+extern int verbose;
-double xpest(double **gg, int *gobs, int *na, int *nb,
- int neq, double *ppa, double *ppb) ;
+double
+xpest (double **gg, int *gobs, int *na, int *nb, int neq, double *ppa,
+ double *ppb);
-void mk2from3ml(double *xd, double *xc, double p, double pp) ;
-void mk2from2(double *xd, double *xc ) ;
+void
+mk2from3ml (double *xd, double *xc, double p, double pp);
+void
+mk2from2 (double *xd, double *xc);
-void loadpprob(double *pprob, double pa, double pb) ;
-void gen3(double *ww, double a, double b) ;
-
-double xpest2like(double **gg, int *gobs, int *na, int *nb,
- int *iscasearr,
- int neq, double ppa, double ppb, double risk) ;
+void
+loadpprob (double *pprob, double pa, double pb);
+void
+gen3 (double *ww, double a, double b);
+double
+xpest2like (double **gg, int *gobs, int *na, int *nb, int *iscasearr, int neq,
+ double ppa, double ppb, double risk);
// clean up SANS when finalized
-typedef struct {
- SNP *cupt ;
- int numsamps ;
- double admbayessc ;
- double *baymodelsc ;
- double admfsc ;
- double admzscore ;
- double admbsc ;
- double admfccsc ;
- double simpsc[2] ;
- double admyl[3] ;
- double lrmax ;
- double lrsig ;
- double maxlod ;
-/* now start of fine-mapping scores */
- double gscore ;
- double gcheck ;
- double gbayes ;
-} SANS ;
+typedef struct
+{
+ SNP *cupt;
+ int numsamps;
+ double admbayessc;
+ double *baymodelsc;
+ double admfsc;
+ double admzscore;
+ double admbsc;
+ double admfccsc;
+ double simpsc[2];
+ double admyl[3];
+ double lrmax;
+ double lrsig;
+ double maxlod;
+ /* now start of fine-mapping scores */
+ double gscore;
+ double gcheck;
+ double gbayes;
+} SANS;
diff --git a/include/xsearch.h b/include/xsearch.h
index 04d986a..97bd111 100644
--- a/include/xsearch.h
+++ b/include/xsearch.h
@@ -1,19 +1,33 @@
#include <search.h>
-int xfindit(char *ss) ;
-int xloadsearchx(char **ss, int n) ;
-int finddup(char **ss, int n) ;
-void xloadsearch(char **ss, int n) ;
-void xdestroy() ;
+int
+xfindit (char *ss);
+int
+xloadsearchx (char **ss, int n);
+int
+finddup (char **ss, int n);
+void
+xloadsearch (char **ss, int n);
+void
+xdestroy ();
-void xhcreate (int n) ;
-void xhdestroy() ;
-ENTRY *xhsearch(ENTRY item, ACTION act) ;
+void
+xhcreate (int n);
+void
+xhdestroy ();
+ENTRY *
+xhsearch (ENTRY item, ACTION act);
-int xlookup(char *key, ACTION act) ;
-int xhash (char *key) ;
-int xhash1(int ww) ;
-int xhash2 (int x) ;
-int xcshift(int x, int shft) ;
-int stringhash(char *key) ;
+int
+xlookup (char *key, ACTION act);
+int
+xhash (char *key);
+int
+xhash1 (int ww);
+int
+xhash2 (int x);
+int
+xcshift (int x, int shft);
+int
+stringhash (char *key);
diff --git a/src/LICENSE.txt b/src/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/src/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/src/Makefile b/src/Makefile
index 890d244..319e8dc 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,30 +1,5 @@
-# ----- If the user defined OPENBLAS on the command line or use that
-ifdef OPENBLAS
-$(info $$OPENBLAS is [${OPENBLAS}])
-else
-# ----- If this is Broad, check the path to see if "use .openblas-0.2.8"
-ifeq ($(DOMAINNAME),broadinstitute.org)
-$(info *** Broad Institute users can execute use .openblas-0.2.8 and use GCC-4.9 to link to OpenBLAS ***)
-else
-# ----- On orchestra this will work
-OPENBLAS=/opt/openblas
-$(info setting $$OPENBLAS to [${OPENBLAS}])
-endif
-endif
-
-ifdef OPENBLAS
-CFLAGS = -I../include -I$(OPENBLAS)/include -D_GNU_SOURCE
-LDFLAGS = -L$(OPENBLAS)/lib -D_GNU_SOURCE
-LDLIBS = -Wl,-Bdynamic -lgsl -Wl,-Bstatic -lopenblas -Wl,-Bdynamic -lgfortran -pthread -lm
-else
-CFLAGS = -I../include -D_GNU_SOURCE
-LDFLAGS = -D_GNU_SOURCE
-LDLIBS = -lgsl -lopenblas -lgfortran -pthread -lm
-endif
-
-CC = gcc
-LD = ld
-
+CFLAGS += -I../include
+LDLIBS += -lgsl -lopenblas -lgfortran -lrt
ifeq ($(OPTIMIZE), 1)
CFLAGS += -O2
@@ -40,7 +15,8 @@ endif
ND=nicksrc
ED=eigensrc
-KG=ksrc
+KD=ksrc
+
NLIB = $(ND)/libnick.a
# ----- phony targets
@@ -58,7 +34,7 @@ install: all
clobber:
rm -f *.o */*.o */*.a
rm -f $(EXE)
- cd ../bin/ ; rm -f $(notdir, $(EXE)) ; cd ../src
+ cd ../bin/ ; rm -f $(notdir $(EXE)) ; cd ../src
clean:
rm -f *.o core core.* *.o
@@ -75,6 +51,8 @@ mergeit: mergeit.o mcio.o admutils.o $(NLIB)
pca: pca.o $(ED)/eigsubs.o eigx.o $(NLIB)
+pcaselection: pcaselection.o mcio.o admutils.o $(NLIB)
+
$(ED)/pcatoy: $(ED)/pcatoy.o eigensrc/eigsubs.o eigensrc/eigx.o $(NLIB)
$(ED)/smartrel: $(ED)/smartrel.o twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o \
@@ -84,14 +62,19 @@ $(ED)/smarteigenstrat: $(ED)/smarteigenstrat.o mcio.o admutils.o $(NLIB)
$(ED)/twstats: $(ED)/twstats.o $(NLIB)
-#$(ED)/eigenstrat: $(ED)/eigenstrat.o
+$(ED)/eigenstrat: $(ED)/eigenstrat.o
-#$(ED)/eigenstratQTL: $(ED)/eigenstratQTL.o
+$(ED)/eigenstratQTL: $(ED)/eigenstratQTL.o
$(ED)/smartpca: $(ED)/smartpca.o $(ED)/eigsubs.o $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o \
twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o gval.o \
$(NLIB) \
- $(KG)/kjg_fpca.o $(KG)/kjg_gsl.o
+ $(KD)/kjg_fpca.o $(KD)/kjg_gsl.o
+
+smshrink: smshrink.o $(ED)/eigsubs.o $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o \
+ twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o gval.o \
+ $(NLIB) \
+ $(KD)/kjg_fpca.o $(KD)/kjg_gsl.o
smartpca: $(ED)/smartpca
cp $< $@
@@ -99,7 +82,7 @@ smartpca: $(ED)/smartpca
$(ED)/fffpca: $(ED)/fffpca.o $(ED)/eigsubs.o $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o \
twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o gval.o \
$(NLIB) \
- $(KG)/kjg_fpca.o $(KG)/kjg_gsl.o
+ $(KD)/kjg_fpca.o $(KD)/kjg_gsl.o
fffpca: $(ED)/fffpca
cp $< $@
diff --git a/src/admutils.c b/src/admutils.c
index cc503ea..8e00b3e 100644
--- a/src/admutils.c
+++ b/src/admutils.c
@@ -5,224 +5,264 @@
#include "admutils.h"
#include "packit.h"
-static int fastdupnum = 10 ;
-static double fastdupthresh = 0.75 ;
-static double fastdupkill = 0.75 ;
-static int snptab = NO ;
+static int fastdupnum = 10;
+static double fastdupthresh = 0.75;
+static double fastdupkill = 0.75;
+static int snptab = NO;
+int
+hashit (char *str);
-int hashit (char *str) ;
-
-int countcol(char *fname) {
- FILE *fp ;
- int t ;
+int
+countcol (char *fname)
+{
+ FILE *fp;
+ int t;
- openit(fname, &fp, "r") ;
- t = countcolumns(fp) ;
- fclose(fp) ;
- return t ;
+ openit (fname, &fp, "r");
+ t = countcolumns (fp);
+ fclose (fp);
+ return t;
}
-
-int countcolumns(FILE *fp)
-{ /* count number of text columns separated by whitespace */
- int i=0,c;
+int
+countcolumns (FILE *fp)
+{ /* count number of text columns separated by whitespace */
+ int i = 0, c;
fpos_t ptr;
- if (fgetpos(fp,&ptr)) {
- printf("error counting columns\n");
- return 0;
- }
+ if (fgetpos (fp, &ptr))
+ {
+ printf ("error counting columns\n");
+ return 0;
+ }
- while ( (c = getc(fp)) != '\n' ) {
- if (isgraph(c)) {
- i++;
- while (isgraph(c = getc(fp))) {}
- ungetc(c,fp);
+ while ((c = getc (fp)) != '\n')
+ {
+ if (isgraph(c))
+ {
+ i++;
+ while (isgraph(c = getc (fp)))
+ {
+ }
+ ungetc (c, fp);
+ }
}
- }
- fsetpos(fp,&ptr);
+ fsetpos (fp, &ptr);
return i;
}
-void sett1(double *tt, double theta, int numstates)
+void
+sett1 (double *tt, double theta, int numstates)
{
- if (numstates==2) {
- tt[0] = 1.0-theta ;
- tt[1] = theta ;
- tt[2] = 0.0 ;
+ if (numstates == 2)
+ {
+ tt[0] = 1.0 - theta;
+ tt[1] = theta;
+ tt[2] = 0.0;
}
- if (numstates==3) {
- tt[0] = (1.0-theta)*(1.0-theta) ;
- tt[1] = 2.0*theta*(1.0-theta) ;
- tt[2] = theta*theta ;
+ if (numstates == 3)
+ {
+ tt[0] = (1.0 - theta) * (1.0 - theta);
+ tt[1] = 2.0 * theta * (1.0 - theta);
+ tt[2] = theta * theta;
}
}
-void sett1r(double *tt, double theta, int numstates, double risk)
+void
+sett1r (double *tt, double theta, int numstates, double risk)
{
- double y ;
- sett1(tt, theta, numstates) ;
- tt[1] *= risk ;
- tt[2] *= risk*risk ;
- y = asum(tt, numstates) ;
- vst(tt, tt, 1.0/y, numstates) ;
+ double y;
+ sett1 (tt, theta, numstates);
+ tt[1] *= risk;
+ tt[2] *= risk * risk;
+ y = asum (tt, numstates);
+ vst (tt, tt, 1.0 / y, numstates);
}
-void gettln(SNP *cupt, Indiv *indx,
- double *ptheta, double *plambda, int *pnumstates, int *pignore)
+void
+gettln (SNP *cupt, Indiv *indx, double *ptheta, double *plambda,
+ int *pnumstates, int *pignore)
/* set theta, lambda numstates */
{
- double theta, lambda ;
- int numstates, chrom, ignore ;
-
- theta = indx->theta_mode ;
- lambda = indx->lambda_mode ;
- ignore = indx->ignore ;
- numstates = 3 ;
-
- chrom = cupt -> chrom ;
-
- if (chrom == 23) {
- theta = indx->Xtheta_mode ;
- lambda = indx->Xlambda_mode ;
- if (indx -> gender == 'M') numstates = 2;
- if (indx -> gender == 'U') ignore = YES ;
- }
- if (ptheta !=NULL) *ptheta = theta ;
- if (plambda != NULL) *plambda = lambda ;
- if (pnumstates != NULL) *pnumstates = numstates ;
- if (pignore != NULL) *pignore = ignore ;
+ double theta, lambda;
+ int numstates, chrom, ignore;
+
+ theta = indx->theta_mode;
+ lambda = indx->lambda_mode;
+ ignore = indx->ignore;
+ numstates = 3;
+
+ chrom = cupt->chrom;
+
+ if (chrom == 23)
+ {
+ theta = indx->Xtheta_mode;
+ lambda = indx->Xlambda_mode;
+ if (indx->gender == 'M')
+ numstates = 2;
+ if (indx->gender == 'U')
+ ignore = YES;
+ }
+ if (ptheta != NULL)
+ *ptheta = theta;
+ if (plambda != NULL)
+ *plambda = lambda;
+ if (pnumstates != NULL)
+ *pnumstates = numstates;
+ if (pignore != NULL)
+ *pignore = ignore;
}
-
-void puttln(SNP *cupt, Indiv *indx,
- double ptheta, double plambda)
+void
+puttln (SNP *cupt, Indiv *indx, double ptheta, double plambda)
/* put theta, lambda */
{
- int chrom ;
-
+ int chrom;
- chrom = cupt -> chrom ;
+ chrom = cupt->chrom;
- if (chrom == 23) {
- indx->Xtheta_mode = ptheta;
- indx->Xlambda_mode = plambda ;
- return ;
- }
- indx->theta_mode = ptheta;
- indx->lambda_mode = plambda ;
- return ;
+ if (chrom == 23)
+ {
+ indx->Xtheta_mode = ptheta;
+ indx->Xlambda_mode = plambda;
+ return;
+ }
+ indx->theta_mode = ptheta;
+ indx->lambda_mode = plambda;
+ return;
}
-
-double hwcheck (SNP *cupt, double *cc)
+double
+hwcheck (SNP *cupt, double *cc)
{
- int i, n, g ;
-
+ int i, n, g;
- vzero(cc, 3) ;
+ vzero (cc, 3);
- n = cupt -> ngtypes ;
- for (i=0; i<n; i++) {
- g = getgtypes(cupt, i) ;
- if (g<0) continue ;
- ++cc[g] ;
- }
- return (hwstat(cc)) ;
+ n = cupt->ngtypes;
+ for (i = 0; i < n; i++)
+ {
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ continue;
+ ++cc[g];
+ }
+ return (hwstat (cc));
}
-double hwcheckx (SNP *cupt, Indiv **indm, double *cc)
+double
+hwcheckx (SNP *cupt, Indiv **indm, double *cc)
// deals with X
{
- int i, n, g, ignore, numstates ;
- Indiv *indx ;
- double t, l ;
-
-
- vzero(cc, 3) ;
-
- n = cupt -> ngtypes ;
- for (i=0; i<n; i++) {
- indx = indm[i] ;
- gettln(cupt, indx, &t, &l, &numstates, &ignore) ;
- if (ignore) continue ;
- if (numstates != 3) continue ;
- g = getgtypes(cupt, i) ;
- if (g<0) continue ;
- ++cc[g] ;
- }
- return (hwstat(cc)) ;
+ int i, n, g, ignore, numstates;
+ Indiv *indx;
+ double t, l;
+
+ vzero (cc, 3);
+
+ n = cupt->ngtypes;
+ for (i = 0; i < n; i++)
+ {
+ indx = indm[i];
+ gettln (cupt, indx, &t, &l, &numstates, &ignore);
+ if (ignore)
+ continue;
+ if (numstates != 3)
+ continue;
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ continue;
+ ++cc[g];
+ }
+ return (hwstat (cc));
}
-void hap2dip(SNP *cupt)
+void
+hap2dip (SNP *cupt)
// duplicate chromosomes
{
- int i, n, g ;
-
- n = cupt -> ngtypes ;
- for (i=0; i<n; i++) {
- g = getgtypes(cupt, i) ;
- if (g<0) continue ;
- if (g==2) g = -1 ;
- if (g==1) g = 2 ;
- putgtypes(cupt, i, g) ;
- }
+ int i, n, g;
+
+ n = cupt->ngtypes;
+ for (i = 0; i < n; i++)
+ {
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ continue;
+ if (g == 2)
+ g = -1;
+ if (g == 1)
+ g = 2;
+ putgtypes (cupt, i, g);
+ }
}
-void flipalleles(SNP *cupt)
+void
+flipalleles (SNP *cupt)
// flip reference, variant counts
{
- int i, n, g ;
- n = cupt -> ngtypes ;
- for (i=0; i<n; i++) {
- g = getgtypes(cupt, i) ;
- if (g<0) continue ;
- putgtypes(cupt, i, 2-g) ;
- }
+ int i, n, g;
+ n = cupt->ngtypes;
+ for (i = 0; i < n; i++)
+ {
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ continue;
+ putgtypes (cupt, i, 2 - g);
+ }
}
-void flipalleles_phased(SNP *cupt)
+void
+flipalleles_phased (SNP *cupt)
// flip reference, variant counts
{
- int i, n, g ;
- n = cupt -> ngtypes ;
- for (i=0; i<n; i++) {
- g = getgtypes(cupt, i) ;
- if (g<0) continue ;
- if (g>1) fatalx("genotype > 1 in phased file\n") ;
- putgtypes(cupt, i, 1-g) ;
- }
+ int i, n, g;
+ n = cupt->ngtypes;
+ for (i = 0; i < n; i++)
+ {
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ continue;
+ if (g > 1)
+ fatalx ("genotype > 1 in phased file\n");
+ putgtypes (cupt, i, 1 - g);
+ }
}
-
-void cntit(double *xc, SNP *c1, SNP *c2)
+void
+cntit (double *xc, SNP *c1, SNP *c2)
{
- int n, i, e, f ;
-
- n = MIN(c1->ngtypes, c2->ngtypes) ;
- vzero(xc, 9) ;
- for (i=0; i<n; i++) {
- e = getgtypes(c1, i) ;
- f = getgtypes(c2, i) ;
- if (e<0) continue ;
- if (f<0) continue ;
- ++xc[3*e+f] ;
- }
+ int n, i, e, f;
+
+ n = MIN(c1->ngtypes, c2->ngtypes);
+ vzero (xc, 9);
+ for (i = 0; i < n; i++)
+ {
+ e = getgtypes (c1, i);
+ f = getgtypes (c2, i);
+ if (e < 0)
+ continue;
+ if (f < 0)
+ continue;
+ ++xc[3 * e + f];
+ }
}
/******** UTILITY FUNCTIONS **********/
-void fataly(const char *name)
+void
+fataly (const char *name)
{
- printf("%s",name);
- exit(1);
+ printf ("%s", name);
+ exit (1);
}
-int compare_doubles (const void *a, const void *b)
+int
+compare_doubles (const void *a, const void *b)
{
const double *da = (const double *) a;
const double *db = (const double *) b;
@@ -230,863 +270,1029 @@ int compare_doubles (const void *a, const void *b)
return (*da > *db) - (*da < *db);
}
-void pcheck (char *name, char x)
+void
+pcheck (char *name, char x)
{
-
- if (name != NULL) return ;
- if (x != CNULL)
- fatalx ("parameter %c compulsory\n",x) ;
- else fatalx("missing argument\n") ;
+
+ if (name != NULL)
+ return;
+ if (x != CNULL)
+ fatalx ("parameter %c compulsory\n", x);
+ else
+ fatalx ("missing argument\n");
}
-void printm(double **M, int numstates)
+void
+printm (double **M, int numstates)
{
- int i,j ;
- printf("M:\n") ;
- for (i=0; i<numstates; i++) {
- for (j=0; j<numstates; j++) {
- printf("%9.3f ", M[j][i]) ;
- }
- printf("\n") ;
- }
+ int i, j;
+ printf ("M:\n");
+ for (i = 0; i < numstates; i++)
+ {
+ for (j = 0; j < numstates; j++)
+ {
+ printf ("%9.3f ", M[j][i]);
+ }
+ printf ("\n");
+ }
}
+int
+numvalidgtypes (SNP *cupt)
+{
+ int nvalid, n, i, k;
+ if (cupt->isfake)
+ return 0;
+ n = cupt->ngtypes;
+ nvalid = 0;
+ for (i = 0; i < n; i++)
+ {
+ k = getgtypes (cupt, i);
+ if (k >= 0)
+ ++nvalid;
+ }
+ return nvalid;
+}
-int numvalidgtypes(SNP *cupt)
+int
+numvalids (Indiv *indx, SNP **snpmarkers, int fc, int lc)
{
- int nvalid, n, i, k ;
- if (cupt -> isfake) return 0 ;
- n = cupt -> ngtypes ;
- nvalid = 0 ;
- for (i=0; i<n; i++) {
- k = getgtypes(cupt, i) ;
- if (k >= 0) ++nvalid ;
- }
- return nvalid ;
-}
-
-int numvalids(Indiv *indx, SNP **snpmarkers, int fc, int lc)
-{
- SNP *cupt ;
- int idnum, numstates, ignore ;
- int k, nval= 0 ;
-
- if (fc>lc) return 0 ;
- if (lc<0) return 0 ;
- idnum = indx -> idnum ;
- for (k=fc; k<=lc; ++k) {
- cupt = snpmarkers[k] ;
- if (cupt -> isfake) continue ;
- if (cupt -> ignore) continue ;
-/**
- gettln(cupt, indx, NULL, NULL, &numstates, &ignore) ;
- if (ignore) continue ;
-*/
- if (cupt -> ngtypes == 0) continue ;
- if (getgtypes(cupt, idnum) >= 0) ++nval ;
- }
- return nval ;
-}
-
-double malefreq(Indiv **indmarkers, int numindivs)
+ SNP *cupt;
+ int idnum, numstates, ignore;
+ int k, nval = 0;
+
+ if (fc > lc)
+ return 0;
+ if (lc < 0)
+ return 0;
+ idnum = indx->idnum;
+ for (k = fc; k <= lc; ++k)
+ {
+ cupt = snpmarkers[k];
+ if (cupt->isfake)
+ continue;
+ if (cupt->ignore)
+ continue;
+ /**
+ gettln(cupt, indx, NULL, NULL, &numstates, &ignore) ;
+ if (ignore) continue ;
+ */
+ if (cupt->ngtypes == 0)
+ continue;
+ if (getgtypes (cupt, idnum) >= 0)
+ ++nval;
+ }
+ return nval;
+}
+
+double
+malefreq (Indiv **indmarkers, int numindivs)
/* pop freq of males in sample */
{
- int i ;
- Indiv *indx ;
- double cmale, cfemale ;
+ int i;
+ Indiv *indx;
+ double cmale, cfemale;
+
+ cmale = 0;
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indmarkers[i];
+ if (indx->gender == 'M')
+ ++cmale;
+ }
- cmale = 0 ;
- for (i=0; i<numindivs; ++i) {
- indx = indmarkers[i] ;
- if (indx -> gender == 'M') ++cmale ;
- }
+ cmale /= (double) numindivs;
- cmale /= (double) numindivs ;
+ return cmale;
+}
- return cmale ;
+int
+isimatch (int a, int b)
+{
+ if (a < 0)
+ return YES;
+ if (b < 0)
+ return YES;
+ if (a == b)
+ return YES;
+ return NO;
}
-int isimatch(int a, int b)
+void
+gethpos (int *fc, int *lc, SNP **snpm, int numsnps, int xchrom, int lo, int hi)
{
- if (a < 0) return YES ;
- if (b < 0) return YES ;
- if (a==b) return YES ;
- return NO;
-}
-
-void gethpos(int *fc, int *lc, SNP **snpm, int numsnps,
- int xchrom, int lo, int hi)
-{
- int k, xfc, xlc, pos ;
- SNP *cupt ;
-
- xfc = 9999999 ;
- xlc = -9999999 ;
- for (k=0; k<numsnps; k++) {
- cupt = snpm[k] ;
- if (cupt -> chrom != xchrom) continue ;
- pos = cupt -> physpos ;
- if (pos < lo) continue ;
- if (pos > hi) continue ;
- xfc = MIN(xfc, k) ;
- xlc = MAX(xlc, k) ;
- }
- *fc = xfc ;
- *lc = xlc ;
-}
-
-void makedir (char * dirname)
+ int k, xfc, xlc, pos;
+ SNP *cupt;
+
+ xfc = 9999999;
+ xlc = -9999999;
+ for (k = 0; k < numsnps; k++)
+ {
+ cupt = snpm[k];
+ if (cupt->chrom != xchrom)
+ continue;
+ pos = cupt->physpos;
+ if (pos < lo)
+ continue;
+ if (pos > hi)
+ continue;
+ xfc = MIN(xfc, k);
+ xlc = MAX(xlc, k);
+ }
+ *fc = xfc;
+ *lc = xlc;
+}
+
+void
+makedir (char * dirname)
// AT wrote original
// sets up directory. Will fail hard if directory does not
// exist and can't be made
{
- int fdir ;
- fdir = open(dirname,O_RDONLY,0);
- if (fdir >= 0) {
- close (fdir) ;
- return ;
- }
- fdir = mkdir(dirname,0775);
- if (fdir < 0) {
- perror("makedir") ;
- fatalx("(makedir) directory %s not created\n") ;
- }
- printf("Created a new directory %s\n",dirname);
+ int fdir;
+ fdir = open (dirname, O_RDONLY, 0);
+ if (fdir >= 0)
+ {
+ close (fdir);
+ return;
+ }
+ fdir = mkdir (dirname, 0775);
+ if (fdir < 0)
+ {
+ perror ("makedir");
+ fatalx ("(makedir) directory %s not created\n");
+ }
+ printf ("Created a new directory %s\n", dirname);
}
-
int
-indxindex(char **namelist, int len, char *strid)
+indxindex (char **namelist, int len, char *strid)
// look for string in list
{
- int k ;
- for (k=0; k< len; k++) {
- if (strcmp(namelist[k], strid) == 0) return k ;
- }
- return -1 ;
+ int k;
+ for (k = 0; k < len; k++)
+ {
+ if (strcmp (namelist[k], strid) == 0)
+ return k;
+ }
+ return -1;
}
-int indindex(Indiv **indivmarkers, int numindivs, char *indid)
+int
+indindex (Indiv **indivmarkers, int numindivs, char *indid)
/* hash table would be good here */
{
- int k ;
- for (k=0; k< numindivs; k++) {
- if (strcmp(indivmarkers[k] -> ID, indid) == 0) return k ;
- }
- return -1 ;
+ int k;
+ for (k = 0; k < numindivs; k++)
+ {
+ if (strcmp (indivmarkers[k]->ID, indid) == 0)
+ return k;
+ }
+ return -1;
}
-void inddupcheck(Indiv **indivmarkers, int numindivs)
+void
+inddupcheck (Indiv **indivmarkers, int numindivs)
{
- // fail hard if duplicate
- int t, k, n ;
- char **ss ;
-
- freesnpindex() ;
- n = numindivs ;
- ZALLOC(ss, n, char *) ;
- for (k=0; k< n; k++) {
- ss[k] = strdup(indivmarkers[k] -> ID) ;
- }
- t = finddup(ss, n) ;
- if (t>=0) fatalx("duplicate sample: %s\n", ss[t]) ;
- freeup(ss, n) ;
- free(ss) ;
-}
-
-int snpindex(SNP **snpmarkers, int numsnps, char *snpid)
+ // fail hard if duplicate
+ int t, k, n;
+ char **ss;
+
+ freesnpindex ();
+ n = numindivs;
+ ZALLOC(ss, n, char *);
+ for (k = 0; k < n; k++)
+ {
+ ss[k] = strdup (indivmarkers[k]->ID);
+ }
+ t = finddup (ss, n);
+ if (t >= 0)
+ fatalx ("duplicate sample: %s\n", ss[t]);
+ freeup (ss, n);
+ free (ss);
+}
+
+int
+snpindex (SNP **snpmarkers, int numsnps, char *snpid)
{
- int k ;
- char **ss ;
+ int k;
+ char **ss;
- if (snptab==NO) {
+ if (snptab == NO)
+ {
// set up hash table
- snptab = YES ;
- ZALLOC(ss, numsnps, char *) ;
- for (k=0; k< numsnps; k++) {
- ss[k] = strdup(snpmarkers[k] -> ID) ;
- }
- xloadsearch(ss, numsnps) ;
- freeup(ss, numsnps) ;
- free(ss) ;
- }
-
- k = xfindit(snpid) ;
- return k ;
-}
-void freesnpindex()
+ snptab = YES;
+ ZALLOC(ss, numsnps, char *);
+ for (k = 0; k < numsnps; k++)
+ {
+ ss[k] = strdup (snpmarkers[k]->ID);
+ }
+ xloadsearch (ss, numsnps);
+ freeup (ss, numsnps);
+ free (ss);
+ }
+
+ k = xfindit (snpid);
+ return k;
+}
+void
+freesnpindex ()
{
- if (snptab == NO) return ;
- snptab = NO ;
- xdestroy() ;
+ if (snptab == NO)
+ return;
+ snptab = NO;
+ xdestroy ();
}
-int ignoresnp(SNP *cupt)
+int
+ignoresnp (SNP *cupt)
{
- if (cupt -> ignore) return YES ;
- if (cupt -> isfake) return YES ;
- if (cupt -> ngtypes == 0) return YES ;
- if (cupt -> isrfake) return NO ;
- return NO ;
+ if (cupt->ignore)
+ return YES;
+ if (cupt->isfake)
+ return YES;
+ if (cupt->ngtypes == 0)
+ return YES;
+ if (cupt->isrfake)
+ return NO;
+ return NO;
}
-double entrop(double *a, int n)
+double
+entrop (double *a, int n)
{
- int i ;
- double ysum, t, ans ;
-
- ans = 0.0 ;
- ysum = asum(a,n) ;
- for (i=0; i<n ; i++) {
- t = a[i]/ysum ;
- ans += xxlog2(t) ;
- }
- return -ans ;
-}
-double xxlog2(double t)
+ int i;
+ double ysum, t, ans;
+
+ ans = 0.0;
+ ysum = asum (a, n);
+ for (i = 0; i < n; i++)
+ {
+ t = a[i] / ysum;
+ ans += xxlog2 (t);
+ }
+ return -ans;
+}
+double
+xxlog2 (double t)
{
- if (t<=0.0) return t ;
- return t * log(t) / log(2.0) ;
+ if (t <= 0.0)
+ return t;
+ return t * log (t) / log (2.0);
}
-void
-testnan(double *a, int n)
+void
+testnan (double *a, int n)
{
- int i ;
+ int i;
- for (i=0; i<n; i++) {
- if (!finite(a[i])) fatalx("(testnan) fails: index %d\n",i) ;
- }
+ for (i = 0; i < n; i++)
+ {
+ if (!finite (a[i]))
+ fatalx ("(testnan) fails: index %d\n", i);
+ }
}
-void getgall(SNP *cupt, int *x, int n)
-{
- int k, t, a ;
- unsigned char b, w ;
-
- if (cupt -> gtypes == NULL) {
- ivclear(x, -1, n) ;
- return ;
- }
-
- if (!packmode) {
- copyiarr(cupt-> gtypes, x, n) ;
- return ;
- }
-
- k = 0 ;
- for (a=0; 4*a<n; ++a) {
- w = cupt -> pbuff[a] ;
- for (t = 0; t < 4 ; t++) {
- b = w >> 2*(3-t) ;
- x[k] = b & 3 ;
- ++k ;
- if (k>=n) break ;
- }
- }
-}
-
-int getgtypes(SNP *cupt, int k)
+void
+getgall (SNP *cupt, int *x, int n)
{
- char *buff ;
- int g ;
+ int k, t, a;
+ unsigned char b, w;
- if (cupt -> gtypes == NULL) return -1 ;
+ if (cupt->gtypes == NULL)
+ {
+ ivclear (x, -1, n);
+ return;
+ }
- if (packmode) {
- buff = cupt -> pbuff ;
- g = rbuff((unsigned char *)buff, k) ;
- if (g==3) g = -1 ;
- return g ;
- }
+ if (!packmode)
+ {
+ copyiarr (cupt->gtypes, x, n);
+ return;
+ }
- return cupt -> gtypes[k] ;
+ k = 0;
+ for (a = 0; 4 * a < n; ++a)
+ {
+ w = cupt->pbuff[a];
+ for (t = 0; t < 4; t++)
+ {
+ b = w >> 2 * (3 - t);
+ x[k] = b & 3;
+ ++k;
+ if (k >= n)
+ break;
+ }
+ }
}
-void putgtypes(SNP *cupt, int k, int val)
+int
+getgtypes (SNP *cupt, int k)
{
- char *buff ;
- int g ;
+ char *buff;
+ int g;
+
+ if (cupt->gtypes == NULL)
+ return -1;
+
+ if (packmode)
+ {
+ buff = cupt->pbuff;
+ g = rbuff ((unsigned char *) buff, k);
+ if (g == 3)
+ g = -1;
+ return g;
+ }
- if (k>= cupt -> ngtypes) fatalx("(putgtypes)\n") ;
- if (packmode) {
- buff = cupt -> pbuff ;
- g = val ;
- if (g <0) g=3 ;
- wbuff((unsigned char *)buff, k, g) ;
- return ;
- }
- cupt ->gtypes[k] = val ;
+ return cupt->gtypes[k];
}
-int getep(SNP *cupt, int k)
+void
+putgtypes (SNP *cupt, int k, int val)
{
- char *buff ;
- int g ;
+ char *buff;
+ int g;
+
+ if (k >= cupt->ngtypes)
+ fatalx ("(putgtypes)\n");
+ if (packmode)
+ {
+ buff = cupt->pbuff;
+ g = val;
+ if (g < 0)
+ g = 3;
+ wbuff ((unsigned char *) buff, k, g);
+ return;
+ }
+ cupt->gtypes[k] = val;
+}
- if (cupt -> gtypes == NULL) return -1 ;
- if (k>= cupt -> ngtypes) return -1 ;
- buff = cupt -> ebuff ;
- g = rbuff((unsigned char *)buff, k) ;
- if (g==3) g = -1 ;
- return g ;
+int
+getep (SNP *cupt, int k)
+{
+ char *buff;
+ int g;
+
+ if (cupt->gtypes == NULL)
+ return -1;
+ if (k >= cupt->ngtypes)
+ return -1;
+ buff = cupt->ebuff;
+ g = rbuff ((unsigned char *) buff, k);
+ if (g == 3)
+ g = -1;
+ return g;
}
-void putep(SNP *cupt, int k, int val)
+void
+putep (SNP *cupt, int k, int val)
{
- char *buff ;
- int g ;
-
- buff = cupt -> ebuff ;
- if (buff == NULL) fatalx("(putep) no buffer\n") ;
- if (k>= cupt -> ngtypes) fatalx("(putep)\n") ;
- g = val ;
- if (g <0) g=3 ;
- wbuff((unsigned char *)buff, k, g) ;
- return ;
+ char *buff;
+ int g;
+
+ buff = cupt->ebuff;
+ if (buff == NULL)
+ fatalx ("(putep) no buffer\n");
+ if (k >= cupt->ngtypes)
+ fatalx ("(putep)\n");
+ g = val;
+ if (g < 0)
+ g = 3;
+ wbuff ((unsigned char *) buff, k, g);
+ return;
}
-int hasharr(char **xarr, int nxarr)
+int
+hasharr (char **xarr, int nxarr)
// in application ordering matters so we hash order dependent
{
-
- int hash, thash, i, n ;
- hash = 0 ;
+ int hash, thash, i, n;
+
+ hash = 0;
- for (i=0; i< nxarr; i++) {
- thash = hashit(xarr[i]) ;
- hash *= 17 ;
- hash ^= thash ;
- }
- return hash ;
+ for (i = 0; i < nxarr; i++)
+ {
+ thash = hashit (xarr[i]);
+ hash *= 17;
+ hash ^= thash;
+ }
+ return hash;
}
-int hashit (char *str)
+int
+hashit (char *str)
{
-/* simple and unimpressive hash function NJP */
- int j, len, hash ;
+ /* simple and unimpressive hash function NJP */
+ int j, len, hash;
- hash = 0 ;
- len = strlen(str) ;
+ hash = 0;
+ len = strlen (str);
- for (j=0; j<len ; j++) {
- hash *= 23 ;
- hash += (int) str[j] ;
- }
- return hash ;
+ for (j = 0; j < len; j++)
+ {
+ hash *= 23;
+ hash += (int) str[j];
+ }
+ return hash;
}
void
-wbuff(unsigned char *buff, int num, int g)
+wbuff (unsigned char *buff, int num, int g)
// low level routine writes 2 bits to buffer
// g should be 0 1 2 or 3 (3 = missing)
{
- int wnum, wplace ;
- unsigned char mm, msk, ones ;
- static int ncall = 0 ;
-
- if ((g<0) || (g>3)) fatalx("(wbuff) invalid g value\n", g) ;
+ int wnum, wplace;
+ unsigned char mm, msk, ones;
+ static int ncall = 0;
- ++ncall ;
+ if ((g < 0) || (g > 3))
+ fatalx ("(wbuff) invalid g value\n", g);
- msk = 3 << 6 ;
- mm = g << 6 ;
- ones = 0XFF ;
+ ++ncall;
- wnum = num/4 ;
- wplace = num%4 ;
+ msk = 3 << 6;
+ mm = g << 6;
+ ones = 0XFF;
- mm = mm >> (wplace * 2) ;
- msk = (msk >> (wplace *2)) ^ ones ;
- buff[wnum] &= msk ;
- buff[wnum] |= mm ;
+ wnum = num / 4;
+ wplace = num % 4;
-/**
- printf("zz %d %d %d %d %02x\n", num, wnum, wplace, g, buff[wnum]) ;
- printf("yyy %d %d\n", g, rbuff(buff,num)) ;
-*/
+ mm = mm >> (wplace * 2);
+ msk = (msk >> (wplace * 2)) ^ ones;
+ buff[wnum] &= msk;
+ buff[wnum] |= mm;
+
+ /**
+ printf("zz %d %d %d %d %02x\n", num, wnum, wplace, g, buff[wnum]) ;
+ printf("yyy %d %d\n", g, rbuff(buff,num)) ;
+ */
}
int
-rbuff(unsigned char *buff, int num)
+rbuff (unsigned char *buff, int num)
{
- int wnum, wplace, rshft ;
- unsigned char b ;
- static int ncall = 0 ;
-
-// ++ncall ;
+ int wnum, wplace, rshft;
+ unsigned char b;
+ static int ncall = 0;
+// ++ncall ;
- wnum = num >> 2 ;
- wplace = num & 3 ;
+ wnum = num >> 2;
+ wplace = num & 3;
- rshft = (3-wplace) << 1 ;
- b = buff[wnum] >> rshft ;
+ rshft = (3 - wplace) << 1;
+ b = buff[wnum] >> rshft;
- b = b & 3 ;
- return b ;
+ b = b & 3;
+ return b;
}
// fast dup code
-void setfastdupnum(int num)
+void
+setfastdupnum (int num)
{
- fastdupnum = num ;
+ fastdupnum = num;
}
-void setfastdupthresh(double thresh, double kill)
+void
+setfastdupthresh (double thresh, double kill)
{
- fastdupthresh = thresh ;
- fastdupkill = kill ;
+ fastdupthresh = thresh;
+ fastdupkill = kill;
}
void
-killxhets(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs)
+killxhets (SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs)
{
- SNP *cupt ;
- Indiv *indx ;
- int i, k, g ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (cupt -> ignore) continue ;
- if (cupt -> isfake) continue ;
- if (cupt -> chrom != 23) continue ;
- for (k=0; k<numindivs; k++) {
- indx = indivmarkers[k] ;
- if (indx -> gender != 'M') continue ;
- g = getgtypes(cupt, k) ;
- if (g != 1) continue ;
- putgtypes(cupt, k, -1) ;
- }
- }
-}
-
+ SNP *cupt;
+ Indiv *indx;
+ int i, k, g;
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->ignore)
+ continue;
+ if (cupt->isfake)
+ continue;
+ if (cupt->chrom != 23)
+ continue;
+ for (k = 0; k < numindivs; k++)
+ {
+ indx = indivmarkers[k];
+ if (indx->gender != 'M')
+ continue;
+ g = getgtypes (cupt, k);
+ if (g != 1)
+ continue;
+ putgtypes (cupt, k, -1);
+ }
+ }
+}
void
-fastdupcheck(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs)
+fastdupcheck (SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs)
{
- SNP *cupt ;
- Indiv *indx ;
- int *gtypes ;
- int i, j, k, n ;
- int *snphets, *indsnp, tab[15], ww[15], **codeit, *cc, g, *cbuff ;
- int *buff, val, vv, lbuff, itry, ilo, ihi ;
-
- ZALLOC(gtypes, numindivs, int) ;
- ZALLOC(cbuff, 2*numindivs, int) ;
- ZALLOC(codeit, numindivs, int *) ;
- ZALLOC(snphets, numsnps, int) ;
- ZALLOC(indsnp, numsnps, int) ;
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (cupt -> ignore) continue ;
- if (cupt -> isfake) continue ;
- if (cupt -> chrom > 22) continue ;
- grabgtypes(gtypes, cupt, numindivs) ;
- for (k=0; k<numindivs; k++) {
- if (gtypes[k] == 1) ++snphets[i] ;
- }
- }
- ivst(snphets, snphets, -1, numsnps) ;
- isortit(snphets, indsnp, numsnps) ;
+ SNP *cupt;
+ Indiv *indx;
+ int *gtypes;
+ int i, j, k, n;
+ int *snphets, *indsnp, tab[15], ww[15], **codeit, *cc, g, *cbuff;
+ int *buff, val, vv, lbuff, itry, ilo, ihi;
+
+ ZALLOC(gtypes, numindivs, int);
+ ZALLOC(cbuff, 2*numindivs, int);
+ ZALLOC(codeit, numindivs, int *);
+ ZALLOC(snphets, numsnps, int);
+ ZALLOC(indsnp, numsnps, int);
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->ignore)
+ continue;
+ if (cupt->isfake)
+ continue;
+ if (cupt->chrom > 22)
+ continue;
+ grabgtypes (gtypes, cupt, numindivs);
+ for (k = 0; k < numindivs; k++)
+ {
+ if (gtypes[k] == 1)
+ ++snphets[i];
+ }
+ }
+ ivst (snphets, snphets, -1, numsnps);
+ isortit (snphets, indsnp, numsnps);
// make fastdupnum shots at exact match on 15 snps */
- for (itry = 1; itry < fastdupnum; itry++) {
- ilo = 15*itry ;
- if ((ilo+15)>=numsnps) break ;
- for (i=0; i<15; i++) {
- j = indsnp[i+ilo] ;
- tab[i] = j ;
- }
- n = 0 ;
- for (k=0; k<numindivs; ++k) {
- indx = indivmarkers[k] ;
- if (indx -> ignore) continue ;
- for (i=0; i<15; i++) {
- j = tab[i] ;
- g = getgtypes(snpmarkers[j], k) ;
- if (g<0) break ;
- ww[i] = g ;
- }
- if (g < 0 ) continue ;
- cc = codeit[n] = cbuff+2*n ;
- cc[0] = kcode(ww, 15, 4) ;
- cc[1] = k ;
- ++n ;
- }
-
-
- if (n==0) continue ;
- ipsortit(codeit, NULL, n, 2) ;
-
- buff = gtypes ; lbuff = 0; val = -1 ;
-
- for (i=0; i<n; i++) {
- cc=codeit[i] ;
- vv = cc[0] ;
- if (vv != val) {
- cdup(snpmarkers, indivmarkers, numsnps, buff, lbuff) ;
- lbuff = 0 ;
- val = vv ;
- }
- buff[lbuff] = cc[1] ;
- ++lbuff ;
- }
- cdup(snpmarkers, indivmarkers, numsnps, buff, lbuff) ;
- } // itry
-
- free(snphets) ;
- free(indsnp) ;
- free(gtypes) ;
- free(codeit) ;
- free(cbuff) ;
-}
-
-void cdup(SNP **snpm, Indiv **indm, int nsnp, int *buff, int lbuff)
-{
- static int ncall = 0 ;
- SNP * cupt ;
- Indiv *inda, *indb ;
- double ytot, yhit ;
- int g1, g2, k1, k2, match, nomatch ;
- int i1, i2, j ;
-#define MINMARK 200
+ for (itry = 1; itry < fastdupnum; itry++)
+ {
+ ilo = 15 * itry;
+ if ((ilo + 15) >= numsnps)
+ break;
+ for (i = 0; i < 15; i++)
+ {
+ j = indsnp[i + ilo];
+ tab[i] = j;
+ }
+ n = 0;
+ for (k = 0; k < numindivs; ++k)
+ {
+ indx = indivmarkers[k];
+ if (indx->ignore)
+ continue;
+ for (i = 0; i < 15; i++)
+ {
+ j = tab[i];
+ g = getgtypes (snpmarkers[j], k);
+ if (g < 0)
+ break;
+ ww[i] = g;
+ }
+ if (g < 0)
+ continue;
+ cc = codeit[n] = cbuff + 2 * n;
+ cc[0] = kcode (ww, 15, 4);
+ cc[1] = k;
+ ++n;
+ }
+
+ if (n == 0)
+ continue;
+ ipsortit (codeit, NULL, n, 2);
+
+ buff = gtypes;
+ lbuff = 0;
+ val = -1;
+
+ for (i = 0; i < n; i++)
+ {
+ cc = codeit[i];
+ vv = cc[0];
+ if (vv != val)
+ {
+ cdup (snpmarkers, indivmarkers, numsnps, buff, lbuff);
+ lbuff = 0;
+ val = vv;
+ }
+ buff[lbuff] = cc[1];
+ ++lbuff;
+ }
+ cdup (snpmarkers, indivmarkers, numsnps, buff, lbuff);
+ } // itry
+
+ free (snphets);
+ free (indsnp);
+ free (gtypes);
+ free (codeit);
+ free (cbuff);
+}
+void
+cdup (SNP **snpm, Indiv **indm, int nsnp, int *buff, int lbuff)
+{
+ static int ncall = 0;
+ SNP * cupt;
+ Indiv *inda, *indb;
+ double ytot, yhit;
+ int g1, g2, k1, k2, match, nomatch;
+ int i1, i2, j;
+#define MINMARK 200
- if (lbuff <= 1) return ;
- ++ncall ;
+ if (lbuff <= 1)
+ return;
+ ++ncall;
- if (ncall<=1) {
+ if (ncall <= 1)
+ {
//printf ("cdup: %d\n", ncall) ;
- printf("fastdupthresh, kill: %9.3f %9.3f\n", fastdupthresh, fastdupkill) ;
+ printf ("fastdupthresh, kill: %9.3f %9.3f\n", fastdupthresh, fastdupkill);
//printimat(buff, lbuff, 1) ;
- }
+ }
// if (ncall==1) printf(" cdup %9.3f %9.3f\n", fastdupthresh, fastdupkill) ;
- for (i1=0; i1<lbuff; ++i1) {
- for (i2=i1+1; i2<lbuff; ++i2) {
- k1 = buff[i1] ;
- k2 = buff[i2] ;
- match = nomatch = 0 ;
- for (j=0; j<nsnp; ++j) {
- cupt = snpm[j] ;
- if (cupt -> ignore) continue ;
- if (cupt -> isfake) continue ;
- g1 = getgtypes(cupt, k1) ;
- g2 = getgtypes(cupt, k2) ;
- if ( (g1<0) || (g2<0) ) continue ;
- if (g1==g2) ++match ;
- if (g1!=g2) ++nomatch ;
- }
-
- inda = indm[k1] ;
- indb = indm[k2] ;
- ytot = (double) (match + nomatch) ;
- if (ytot< MINMARK) continue ;
- yhit = ((double) match) / ytot ;
-
- if (yhit>fastdupthresh) {
- printdup(snpm, nsnp, inda, indb, match, nomatch) ;
- if (yhit>fastdupkill) killdup(inda, indb, snpm, nsnp) ;
- }
- }
- }
-}
-
-void killdup(Indiv *inda, Indiv *indb, SNP **snpm, int nsnp)
-{
- int t1, t2 ;
- Indiv *indx ;
-
- t1 = numvalids(inda, snpm, 0, nsnp-1) ;
- t2 = numvalids(indb, snpm, 0, nsnp-1) ;
- indx = inda ;
- if (t1>t2) indx = indb ;
- indx -> ignore = YES ;
- printf("dup. %s ignored\n", indx -> ID) ;
+ for (i1 = 0; i1 < lbuff; ++i1)
+ {
+ for (i2 = i1 + 1; i2 < lbuff; ++i2)
+ {
+ k1 = buff[i1];
+ k2 = buff[i2];
+ match = nomatch = 0;
+ for (j = 0; j < nsnp; ++j)
+ {
+ cupt = snpm[j];
+ if (cupt->ignore)
+ continue;
+ if (cupt->isfake)
+ continue;
+ g1 = getgtypes (cupt, k1);
+ g2 = getgtypes (cupt, k2);
+ if ((g1 < 0) || (g2 < 0))
+ continue;
+ if (g1 == g2)
+ ++match;
+ if (g1 != g2)
+ ++nomatch;
+ }
+
+ inda = indm[k1];
+ indb = indm[k2];
+ ytot = (double) (match + nomatch);
+ if (ytot < MINMARK)
+ continue;
+ yhit = ((double) match) / ytot;
+
+ if (yhit > fastdupthresh)
+ {
+ printdup (snpm, nsnp, inda, indb, match, nomatch);
+ if (yhit > fastdupkill)
+ killdup (inda, indb, snpm, nsnp);
+ }
+ }
+ }
}
-void printdup(SNP **snpm, int numsnp, Indiv *inda, Indiv *indb, int nmatch, int nnomatch)
+void
+killdup (Indiv *inda, Indiv *indb, SNP **snpm, int nsnp)
{
- int t1, t2 ;
- double y ;
-
- if (nmatch<=0) return ;
- if (inda -> ignore) return ;
- if (indb -> ignore) return ;
+ int t1, t2;
+ Indiv *indx;
+
+ t1 = numvalids (inda, snpm, 0, nsnp - 1);
+ t2 = numvalids (indb, snpm, 0, nsnp - 1);
+ indx = inda;
+ if (t1 > t2)
+ indx = indb;
+ indx->ignore = YES;
+ printf ("dup. %s ignored\n", indx->ID);
+}
- t1 = numvalids(inda, snpm, 0, numsnp-1) ;
- t2 = numvalids(indb, snpm, 0, numsnp-1) ;
- printf("dup? %s %s match: %d mismatch: %d %d %d ",
- inda->ID, indb -> ID, nmatch, nnomatch, t1, t2) ;
- printf("%20s ", inda->egroup) ;
- printf("%20s", indb->egroup) ;
- y = nnomatch / (double) (nnomatch+nmatch) ;
- printf(" %9.3f", y) ;
- printnl() ;
+void
+printdup (SNP **snpm, int numsnp, Indiv *inda, Indiv *indb, int nmatch,
+ int nnomatch)
+{
+ int t1, t2;
+ double y;
+
+ if (nmatch <= 0)
+ return;
+ if (inda->ignore)
+ return;
+ if (indb->ignore)
+ return;
+
+ t1 = numvalids (inda, snpm, 0, numsnp - 1);
+ t2 = numvalids (indb, snpm, 0, numsnp - 1);
+ printf ("dup? %s %s match: %d mismatch: %d %d %d ", inda->ID, indb->ID,
+ nmatch, nnomatch, t1, t2);
+ printf ("%20s ", inda->egroup);
+ printf ("%20s", indb->egroup);
+ y = nnomatch / (double) (nnomatch + nmatch);
+ printf (" %9.3f", y);
+ printnl ();
}
-int kcode(int *w, int len, int base)
+int
+kcode (int *w, int len, int base)
{
- int i, t ;
- t = 0;
- for (i=0; i<len; i++) {
- t *= base ;
- t += w[i] ;
- }
- return t ;
+ int i, t;
+ t = 0;
+ for (i = 0; i < len; i++)
+ {
+ t *= base;
+ t += w[i];
+ }
+ return t;
}
-int
- grabgtypes(int *gtypes, SNP *cupt, int numindivs)
+int
+grabgtypes (int *gtypes, SNP *cupt, int numindivs)
{
- int k ;
+ int k;
- for (k=0; k<numindivs; k++) {
- gtypes[k] = getgtypes(cupt, k) ;
- }
+ for (k = 0; k < numindivs; k++)
+ {
+ gtypes[k] = getgtypes (cupt, k);
+ }
}
-double kurtosis(double *a, int n)
+double
+kurtosis (double *a, int n)
{
- double y1, y2, y4 ;
- double *w ;
+ double y1, y2, y4;
+ double *w;
- ZALLOC(w, n, double) ;
+ ZALLOC(w, n, double);
- y1 = asum(a,n) / (double) n ;
- vsp(w, a, -y1, n) ;
-
- y2 = asum2(w, n) / (double) n ;
- vst(w, w, 1.0/sqrt(y2), n) ;
+ y1 = asum (a, n) / (double) n;
+ vsp (w, a, -y1, n);
- vvt(w, w, w, n) ;
+ y2 = asum2 (w, n) / (double) n;
+ vst (w, w, 1.0 / sqrt (y2), n);
- y4 = asum2(w, n) / (double) n ;
+ vvt (w, w, w, n);
+ y4 = asum2 (w, n) / (double) n;
- free(w) ;
- return y4 ;
+ free (w);
+ return y4;
}
-int getlist(char *name, char **list)
+int
+getlist (char *name, char **list)
{
#define MAXSTR 128
#define MAXFF 5
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, num=0 ;
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, num = 0;
num = 0;
- if (name == NULL) fatalx("(numlines) no name") ;
- openit(name, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- list[num] = strdup(sx) ;
- ++num ;
- freeup(spt, nsplit) ;
- }
- fclose(fff) ;
- return num ;
-}
-void printvers(char *progname, char *vers)
+ if (name == NULL)
+ fatalx ("(numlines) no name");
+ openit (name, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ list[num] = strdup (sx);
+ ++num;
+ freeup (spt, nsplit);
+ }
+ fclose (fff);
+ return num;
+}
+void
+printvers (char *progname, char *vers)
+{
+ printf ("## %s version: %s", progname, vers);
+ printnl ();
+}
+int
+numvalidind (Indiv **indivmarkers, int numind)
+{
+ int i;
+ int nvalids = 0;
+ Indiv *indx;
+
+ for (i = 0; i < numind; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ ++nvalids;
+ }
+ return nvalids;
+}
+
+void
+numvalidgtallind (int *x, SNP **snpm, int numsnps, int numind)
{
- printf("## %s version: %s", progname, vers) ;
- printnl() ;
-}
-int numvalidind(Indiv **indivmarkers, int numind)
-{
- int i ;
- int nvalids = 0 ;
- Indiv *indx ;
-
- for (i=0; i< numind; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- ++nvalids ;
- }
- return nvalids ;
-}
-
-void numvalidgtallind(int *x, SNP **snpm, int numsnps, int numind) {
// count valids for all
- int n = 0 ;
- int k, t, j ;
- SNP *cupt ;
- int *z ;
-
- ZALLOC(z, numind, int) ;
- ivzero(x, numind) ;
- for (k=0; k< numsnps; ++k) {
- cupt = snpm[k] ;
- if (cupt -> ignore) continue ;
- getgall(cupt, z, numind) ;
- for (j=0; j<numind; ++j) {
- if (z[j] >=0) ++x[j] ;
- }
- }
- free(z) ;
-}
-
-
-int numvalidgtind(SNP **snpm, int numsnps, int ind) {
- int n = 0 ;
- int k, t ;
- SNP *cupt ;
-
- for (k=0; k< numsnps; ++k) {
- cupt = snpm[k] ;
- if (cupt -> ignore) continue ;
- t = getgtypes(cupt, ind) ;
- if (t >= 0) ++n ;
- }
- return n ;
-}
-
-int numvalidgt(Indiv **indivmarkers, SNP *cupt)
- // like numvalidgtypes but tests ignore
-{
- int n, k, nvalids ;
- if (cupt -> gtypes == NULL) return 0 ;
- nvalids = 0 ;
- n = cupt -> ngtypes ;
- for (k=0; k<n; k++) {
- if (indivmarkers[k] -> ignore) continue ;
- if (getgtypes(cupt, k) >=0) ++nvalids ;
- }
- return nvalids ;
-}
-int numvalidgtx(Indiv **indivmarkers, SNP *cupt, int affst)
+ int n = 0;
+ int k, t, j;
+ SNP *cupt;
+ int *z;
+
+ ZALLOC(z, numind, int);
+ ivzero (x, numind);
+ for (k = 0; k < numsnps; ++k)
+ {
+ cupt = snpm[k];
+ if (cupt->ignore)
+ continue;
+ getgall (cupt, z, numind);
+ for (j = 0; j < numind; ++j)
+ {
+ if (z[j] >= 0)
+ ++x[j];
+ }
+ }
+ free (z);
+}
+
+int
+numvalidgtind (SNP **snpm, int numsnps, int ind)
+{
+ int n = 0;
+ int k, t;
+ SNP *cupt;
+
+ for (k = 0; k < numsnps; ++k)
+ {
+ cupt = snpm[k];
+ if (cupt->ignore)
+ continue;
+ t = getgtypes (cupt, ind);
+ if (t >= 0)
+ ++n;
+ }
+ return n;
+}
+
+int
+numvalidgt (Indiv **indivmarkers, SNP *cupt)
+// like numvalidgtypes but tests ignore
+{
+ int n, k, nvalids;
+ if (cupt->gtypes == NULL)
+ return 0;
+ nvalids = 0;
+ n = cupt->ngtypes;
+ for (k = 0; k < n; k++)
+ {
+ if (indivmarkers[k]->ignore)
+ continue;
+ if (getgtypes (cupt, k) >= 0)
+ ++nvalids;
+ }
+ return nvalids;
+}
+int
+numvalidgtx (Indiv **indivmarkers, SNP *cupt, int affst)
// like numvalidgtypes but tests ignore counts only when status=affst
-{
- int n, k, nvalids ;
- if (cupt -> gtypes == NULL) return 0 ;
- nvalids = 0 ;
- n = cupt -> ngtypes ;
- for (k=0; k<n; k++) {
- if (indivmarkers[k] -> ignore) continue ;
- if (indivmarkers[k] -> affstatus != affst) continue ;
- if (getgtypes(cupt, k) >=0) ++nvalids ;
- }
- return nvalids ;
-}
-
-int isxmale(SNP *cupt, Indiv *indx)
{
- if (cupt -> chrom != 23) return NO ;
- if (indx -> gender != 'M') return NO ;
- return YES ;
+ int n, k, nvalids;
+ if (cupt->gtypes == NULL)
+ return 0;
+ nvalids = 0;
+ n = cupt->ngtypes;
+ for (k = 0; k < n; k++)
+ {
+ if (indivmarkers[k]->ignore)
+ continue;
+ if (indivmarkers[k]->affstatus != affst)
+ continue;
+ if (getgtypes (cupt, k) >= 0)
+ ++nvalids;
+ }
+ return nvalids;
+}
+
+int
+isxmale (SNP *cupt, Indiv *indx)
+{
+ if (cupt->chrom != 23)
+ return NO;
+ if (indx->gender != 'M')
+ return NO;
+ return YES;
}
void
-printmatz(double *ww, char **eglist, int n)
+printmatz (double *ww, char **eglist, int n)
{
- int i, j , x ;
- printf(" %4s", " ") ;
- for (i=0; i<n; i++) {
- printf(" %4s", get3(eglist[i])) ;
- }
- printnl() ;
- for (i=0; i<n; i++) {
- printf("%4s", get3(eglist[i])) ;
- for (j=0; j<n; j++) {
- x = nnint(1000*ww[i*n+j]) ;
- printf(" %4d", x) ;
+ int i, j, x;
+ printf (" %4s", " ");
+ for (i = 0; i < n; i++)
+ {
+ printf (" %4s", get3 (eglist[i]));
+ }
+ printnl ();
+ for (i = 0; i < n; i++)
+ {
+ printf ("%4s", get3 (eglist[i]));
+ for (j = 0; j < n; j++)
+ {
+ x = nnint (1000 * ww[i * n + j]);
+ printf (" %4d", x);
+ }
+ printnl ();
}
- printnl() ;
- }
}
void
-printmatz5(double *ww, char **eglist, int n)
+printmatz5 (double *ww, char **eglist, int n)
{
- int i, j , x ;
- printf(" %5s", " ") ;
- for (i=0; i<n; i++) {
- printf(" %5s", get3(eglist[i])) ;
- }
- printnl() ;
- for (i=0; i<n; i++) {
- printf("%5s", get3(eglist[i])) ;
- for (j=0; j<n; j++) {
- x = nnint(1000*ww[i*n+j]) ;
- printf(" %5d", x) ;
+ int i, j, x;
+ printf (" %5s", " ");
+ for (i = 0; i < n; i++)
+ {
+ printf (" %5s", get3 (eglist[i]));
+ }
+ printnl ();
+ for (i = 0; i < n; i++)
+ {
+ printf ("%5s", get3 (eglist[i]));
+ for (j = 0; j < n; j++)
+ {
+ x = nnint (1000 * ww[i * n + j]);
+ printf (" %5d", x);
+ }
+ printnl ();
}
- printnl() ;
- }
}
void
-printmatz10(double *ww, char **eglist, int n)
+printmatz10 (double *ww, char **eglist, int n)
{
- int i, j , x ;
- printf(" %5s", " ") ;
- for (i=0; i<n; i++) {
- printf(" %10s", get3(eglist[i])) ;
- }
- printnl() ;
- for (i=0; i<n; i++) {
- printf("%5s", get3(eglist[i])) ;
- for (j=0; j<n; j++) {
- x = nnint(1000000*ww[i*n+j]) ;
- printf(" %10d", x) ;
+ int i, j, x;
+ printf (" %5s", " ");
+ for (i = 0; i < n; i++)
+ {
+ printf (" %10s", get3 (eglist[i]));
+ }
+ printnl ();
+ for (i = 0; i < n; i++)
+ {
+ printf ("%5s", get3 (eglist[i]));
+ for (j = 0; j < n; j++)
+ {
+ x = nnint (1000000 * ww[i * n + j]);
+ printf (" %10d", x);
+ }
+ printnl ();
}
- printnl() ;
- }
}
-
-
-char *get3(char *ss)
+char *
+get3 (char *ss)
{
- return getshort(ss, 3) ;
+ return getshort (ss, 3);
}
-char *getshort(char *ss, int n)
+char *
+getshort (char *ss, int n)
{
- static char xxx[MAXSTR] ;
- strcpy(xxx, ss) ;
- xxx[n-2] = ' ' ;
- xxx[n-1] = CNULL ;
- return xxx ;
+ static char xxx[MAXSTR];
+ strcpy (xxx, ss);
+ xxx[n - 2] = ' ';
+ xxx[n - 1] = CNULL;
+ return xxx;
}
-
-int setid2pops(char *idpopstring, Indiv **indmarkers, int numindivs)
+int
+setid2pops (char *idpopstring, Indiv **indmarkers, int numindivs)
// replace pop by ID for certain samples
{
#define MAXS 1000
- char *spt[MAXS] ;
- char *sx ;
- int nsplit, k, t ;
- Indiv *indx ;
-
- nsplit = splitupx(idpopstring, spt, MAXS, ':') ;
- for (k=0; k<nsplit; ++k) {
- sx = spt[k] ;
- t = indindex(indmarkers, numindivs, sx) ;
- if (t<0) {
- printf("(setid2pops): %s not found\n") ;
- continue ;
- }
- indx = indmarkers[t] ;
- freestring(&indx -> egroup) ;
- indx -> egroup = strdup(indx -> ID) ;
- }
- freeup(spt, nsplit) ;
- return nsplit ;
+ char *spt[MAXS];
+ char *sx;
+ int nsplit, k, t;
+ Indiv *indx;
+
+ nsplit = splitupx (idpopstring, spt, MAXS, ':');
+ for (k = 0; k < nsplit; ++k)
+ {
+ sx = spt[k];
+ t = indindex (indmarkers, numindivs, sx);
+ if (t < 0)
+ {
+ printf ("(setid2pops): %s not found\n");
+ continue;
+ }
+ indx = indmarkers[t];
+ freestring (&indx->egroup);
+ indx->egroup = strdup (indx->ID);
+ }
+ freeup (spt, nsplit);
+ return nsplit;
}
-
-
-
-
-
-
-
-
diff --git a/src/baseprog.c b/src/baseprog.c
index 5c05c35..1539ad7 100644
--- a/src/baseprog.c
+++ b/src/baseprog.c
@@ -16,7 +16,6 @@
#include "egsubs.h"
#include "exclude.h"
-
#define WVERSION "420"
// badpairsname added
@@ -28,234 +27,258 @@
New I/O (mcio.c) added
New admutils (snpindex hash)
mcio bug fixed (large files)
-*/
-
+ */
#define MAXFL 50
#define MAXSTR 512
-extern int packmode ;
+extern int packmode;
-char *trashdir = "/var/tmp" ;
-extern int verbose ;
-int qtmode = NO ;
+char *trashdir = "/var/tmp";
+extern int verbose;
+int qtmode = NO;
Indiv **indivmarkers;
-SNP **snpmarkers ;
-int numsnps, numindivs ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *genooutfilename = NULL ;
-char *indoutfilename = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *goodsnpname = NULL ;
-char *badpairsname = NULL ;
-char *markername = NULL ;
-char *idname = NULL ;
-
-char *outputname = NULL ;
-FILE *ofile ;
-
-double fakespacing = 0.0 ;
-
-char unknowngender = 'U' ;
-
-void readcommands(int argc, char **argv) ;
-void dophyscheck(SNP **snpm, int numsnps) ;
-
-int main(int argc, char **argv)
+SNP **snpmarkers;
+int numsnps, numindivs;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *genooutfilename = NULL;
+char *indoutfilename = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *goodsnpname = NULL;
+char *badpairsname = NULL;
+char *markername = NULL;
+char *idname = NULL;
+
+char *outputname = NULL;
+FILE *ofile;
+
+double fakespacing = 0.0;
+
+char unknowngender = 'U';
+
+void
+readcommands (int argc, char **argv);
+void
+dophyscheck (SNP **snpm, int numsnps);
+
+int
+main (int argc, char **argv)
{
- int i, j, k, g ;
- SNP *cupt ;
- Indiv *indx ;
- int ch1, ch2 ;
-
- int numvind, nignore, numrisks = 1 ;
- int markernum, idnum ;
-
- ofile = stdout;
- packmode = YES ;
- readcommands(argc, argv) ;
- if (indivname == NULL) {
- printf("no indivname\n") ;
- return 0 ;
- }
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
+ int i, j, k, g;
+ SNP *cupt;
+ Indiv *indx;
+ int ch1, ch2;
+
+ int numvind, nignore, numrisks = 1;
+ int markernum, idnum;
+
+ ofile = stdout;
+ packmode = YES;
+ readcommands (argc, argv);
+ if (indivname == NULL)
+ {
+ printf ("no indivname\n");
+ return 0;
+ }
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
- numsnps =
- getsnps(snpname, &snpmarkers, fakespacing, badsnpname, &nignore, numrisks) ;
+ numsnps = getsnps (snpname, &snpmarkers, fakespacing, badsnpname, &nignore,
+ numrisks);
// fakespacing 0.0 (default)
- numindivs = getindivs(indivname, &indivmarkers) ;
- setstatus(indivmarkers, numindivs, "Case") ;
+ numindivs = getindivs (indivname, &indivmarkers);
+ setstatus (indivmarkers, numindivs, "Case");
- setgenotypename(&genotypename, indivname) ;
+ setgenotypename (&genotypename, indivname);
- printf("genotypename: %s\n", genotypename) ;
+ printf ("genotypename: %s\n", genotypename);
- if (genotypename != NULL) {
- getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
+ if (genotypename != NULL)
+ {
+ getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
-/**
- if (badpairsname != NULL) {
- loadbadpsc(snpmarkers, numsnps, NO, goodsnpname) ;
- dobadpairs(badpairsname, snpmarkers, numsnps) ;
- }
-*/
- }
- dophyscheck(snpmarkers, numsnps) ;
-
- numvind = numvalidind(indivmarkers, numindivs) ;
- printf("\n\n") ;
- printf("numindivs: %d valid: %d numsnps: %d nignore: %d\n" ,
- numindivs, numvind, numsnps, nignore) ;
-
- if (verbose) {
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- printf("%20s ", indx -> ID) ;
- for (j=0; j<numsnps; ++j) {
- cupt = snpmarkers[j] ;
- if (cupt -> ignore) continue ;
- g = getgtypes(cupt, i) ;
- if (g<0) g = 9 ;
- printf("%1d", g) ;
- }
- printf(" %20s", indx -> egroup) ;
- printnl() ;
+ /**
+ if (badpairsname != NULL) {
+ loadbadpsc(snpmarkers, numsnps, NO, goodsnpname) ;
+ dobadpairs(badpairsname, snpmarkers, numsnps) ;
+ }
+ */
+ }
+ dophyscheck (snpmarkers, numsnps);
+
+ numvind = numvalidind (indivmarkers, numindivs);
+ printf ("\n\n");
+ printf ("numindivs: %d valid: %d numsnps: %d nignore: %d\n", numindivs,
+ numvind, numsnps, nignore);
+
+ if (verbose)
+ {
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ printf ("%20s ", indx->ID);
+ for (j = 0; j < numsnps; ++j)
+ {
+ cupt = snpmarkers[j];
+ if (cupt->ignore)
+ continue;
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ g = 9;
+ printf ("%1d", g);
+ }
+ printf (" %20s", indx->egroup);
+ printnl ();
+ }
}
- }
// numsnps includes fakes
- if (markername != NULL) {
- markernum = snpindex(snpmarkers, numsnps, markername) ;
- if (markernum < 0) fatalx("markername %s not found\n", markername) ;
- cupt = snpmarkers[markernum] ;
- printf("markername: %s %d %9.3f %12.0f\n",
- cupt -> ID, cupt -> chrom, cupt -> genpos, cupt -> physpos) ;
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- g = getgtypes(cupt, i) ;
- printf("%20s %20s %2d\n", cupt -> ID, indx -> ID, g) ;
- }
- }
-
- if (idname != NULL) {
- idnum = indindex(indivmarkers, numindivs, idname) ;
- if (idnum < 0) fatalx("idname %s not found\n", idname) ;
- indx = indivmarkers[idnum] ;
- printf("idname: %20s %c %20s\n",
- indx -> ID, indx -> gender, indx -> egroup) ;
- for (j=0; j<numsnps; ++j) {
- cupt = snpmarkers[j] ;
- if (cupt -> ignore) continue ;
- g = getgtypes(cupt, idnum) ;
- printf("%20s %20s %2d", cupt -> ID, indx -> ID, g) ;
- printf(" %3d %12.0f", cupt -> chrom, cupt -> physpos) ;
- printf(" %c %c", cupt -> alleles[0], cupt -> alleles[1]) ;
- printnl() ;
- }
- }
+ if (markername != NULL)
+ {
+ markernum = snpindex (snpmarkers, numsnps, markername);
+ if (markernum < 0)
+ fatalx ("markername %s not found\n", markername);
+ cupt = snpmarkers[markernum];
+ printf ("markername: %s %d %9.3f %12.0f\n", cupt->ID, cupt->chrom,
+ cupt->genpos, cupt->physpos);
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ g = getgtypes (cupt, i);
+ printf ("%20s %20s %2d\n", cupt->ID, indx->ID, g);
+ }
+ }
-/**
- if (genotypename != NULL) {
+ if (idname != NULL)
+ {
+ idnum = indindex (indivmarkers, numindivs, idname);
+ if (idnum < 0)
+ fatalx ("idname %s not found\n", idname);
+ indx = indivmarkers[idnum];
+ printf ("idname: %20s %c %20s\n", indx->ID, indx->gender,
+ indx->egroup);
+ for (j = 0; j < numsnps; ++j)
+ {
+ cupt = snpmarkers[j];
+ if (cupt->ignore)
+ continue;
+ g = getgtypes (cupt, idnum);
+ printf ("%20s %20s %2d", cupt->ID, indx->ID, g);
+ printf (" %3d %12.0f", cupt->chrom, cupt->physpos);
+ printf (" %c %c", cupt->alleles[0], cupt->alleles[1]);
+ printnl ();
+ }
+ }
+
+ /**
+ if (genotypename != NULL) {
printdata(genooutfilename, indoutfilename, snpmarkers, indivmarkers, numsnps, numindivs, NO) ;
- }
-*/
+ }
+ */
- printf("##end of run\n") ;
- return 0 ;
+ printf ("##end of run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i,haploid=0;
- char *parname = NULL ;
- phandle *ph ;
- char str[5000] ;
- char *tempname ;
- int n ;
-
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
-/**
-DIR2: /fg/nfiles/admixdata/ms2
-SSSS: DIR2/outfiles
-genotypename: DIR2/autos_ccshad_fakes
-eglistname: DIR2/eurlist
-output: eurout
-*/
- getint(ph, "packmode:", &packmode) ; // controls internals
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "goodsnpname:", &goodsnpname) ;
- getstring(ph, "badpairsname:", &badpairsname) ;
- getstring(ph, "markername:", &markername) ;
- getstring(ph, "idname:", &idname) ;
- getdbl(ph, "fakespacing:", &fakespacing) ;
- getint(ph, "familynames:", &familynames) ;
- writepars(ph) ;
- closepars(ph) ;
+ int i, haploid = 0;
+ char *parname = NULL;
+ phandle *ph;
+ char str[5000];
+ char *tempname;
+ int n;
+
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
+
+ switch (i)
+ {
+
+ case 'p':
+ parname = strdup (optarg);
+ break;
+
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
+
+ case 'V':
+ verbose = YES;
+ break;
+
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
+
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ /**
+ DIR2: /fg/nfiles/admixdata/ms2
+ SSSS: DIR2/outfiles
+ genotypename: DIR2/autos_ccshad_fakes
+ eglistname: DIR2/eurlist
+ output: eurout
+ */
+ getint (ph, "packmode:", &packmode); // controls internals
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "goodsnpname:", &goodsnpname);
+ getstring (ph, "badpairsname:", &badpairsname);
+ getstring (ph, "markername:", &markername);
+ getstring (ph, "idname:", &idname);
+ getdbl (ph, "fakespacing:", &fakespacing);
+ getint (ph, "familynames:", &familynames);
+ writepars (ph);
+ closepars (ph);
}
-void dophyscheck(SNP **snpm, int numsnps)
+void
+dophyscheck (SNP **snpm, int numsnps)
{
// catch places where physpos genpos are in opposite order
- SNP *cupt, *cuptold ;
- int i ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (i==0) cuptold = cupt ;
- if (cupt -> isfake) continue ;
- if (cupt -> ignore) continue ;
- if (cupt -> chrom == cuptold -> chrom) {
- if (cupt -> physpos < cuptold -> physpos) {
- printf("physcheck %20s %15s %12.3f %12.3f %13.0f %13.0f\n",
- cuptold->ID, cupt -> ID,
- cuptold -> genpos, cupt -> genpos,
- cuptold -> physpos, cupt -> physpos);
+ SNP *cupt, *cuptold;
+ int i;
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (i == 0)
+ cuptold = cupt;
+ if (cupt->isfake)
+ continue;
+ if (cupt->ignore)
+ continue;
+ if (cupt->chrom == cuptold->chrom)
+ {
+ if (cupt->physpos < cuptold->physpos)
+ {
+ printf ("physcheck %20s %15s %12.3f %12.3f %13.0f %13.0f\n",
+ cuptold->ID, cupt->ID, cuptold->genpos, cupt->genpos,
+ cuptold->physpos, cupt->physpos);
+ }
+ }
+ cuptold = cupt;
}
- }
- cuptold = cupt ;
- }
}
diff --git a/src/convertf.c b/src/convertf.c
index 18660d6..b90fc8f 100644
--- a/src/convertf.c
+++ b/src/convertf.c
@@ -58,7 +58,7 @@
maxmissing added (counts alleles like smartpca)
minor bug fixed for plink homozygous files
polarize added (force homozygotes to 2 if possible)
- if not possible SNP set -> ignore
+ if not possible SNP set -> ignore
bigread now set
map files output 23, 24 for X, Y
@@ -84,870 +84,1008 @@
inddupcheck added (compulsory)
usesamples added => poplistname = NULL)
copyalleles (if newsnpname alleles are copied from old file)
-*/
-
+ */
#define MAXFL 50
#define MAXSTR 512
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
Indiv **indivmarkers, **indm2;
-SNP **snpmarkers ;
-SNP **snpm2 ;
-int zerodistance = NO ; // YES => force gdis 0
-int downsample = NO ; // make pseudo homozygotes
-int pordercheck = YES ;
-
-int numsnps, numindivs, numind2 ;
-int nums2 ;
-
-char *genotypename = NULL ;
-char *genotypelist = NULL ;
-
-char *snpname = NULL ;
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *indivname = NULL ;
-char *newindivname = NULL ;
-char *badsnpname = NULL ;
-char *xregionname = NULL ;
-char *deletesnpoutname = NULL ;
-char *flipsnpname = NULL ;
-char *flipstrandname = NULL ;
-int flipreference = YES ;
-int remapcheck = YES ;
-
-char *poplistname = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-double maxmissfrac = 1000.0 ; // no thresh
-int maxmiss = -1 ; // no thresh
-int killr2 = NO ;
-int mkdiploid = NO ;
-
-int packout = -1 ;
-int tersem = YES ;
-int randommode = NO ;
-int seed = 0 ;
-
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-char *omode = "packedancestrymap" ;
-extern int packmode ;
-int ogmode = NO ;
-int fastdup = NO ;
-int fastdupnum = 10 ;
-double fastdupthresh = .75 ;
-double fastdupkill = .75 ;
-char *polarid = NULL ;
-int polarindex = -1 ;
-
-int phasedmode = NO ;
-int badpedignore = NO ;
-int chimpmode = NO ;
-
-int xchrom = -1 ;
-int lopos = -999999999 ;
-int hipos = 999999999 ;
-int minchrom = 1 ;
-int maxchrom = 97 ;
-
-int deletedup = YES ; // only one marker at a position
-char *newsnpname = NULL ; // new map
-int newignore = YES ; // default ignore snps not in old list
-int polarcheck = NO ;
-int copyalleles = NO ;
-
-char *usesamples = NULL ;
-
-char unknowngender = 'U' ;
-double nhwfilter = -1 ;
-
-
-void setomode(enum outputmodetype *outmode, char *omode) ;
-void readcommands(int argc, char **argv) ;
-void outfiles(char *snpname, char *indname, char *gname, SNP **snpm,
- Indiv **indiv, int numsnps, int numind, int packem, int ogmode) ;
-void remap(SNP **s1, int nums1, SNP **s2, int nums2) ;
-void remapind(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2, int numindivs, int numind2) ;
-void pickx(SNP *c1, SNP *c2, SNP **px1, SNP **px2) ;
-void dedupit(SNP **snpmarkers, int numsnps) ;
-void flipsnps(char *fsname, SNP **snpm, int numsnps, int phasedmode) ;
-void flipstrand(char *fsname, SNP **snpm, int numsnps) ;
-int mkindh2d(Indiv **indivmarkers, Indiv ***pindm2, int numindivs) ;
-void remaph2d(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2, int numindivs, int numind2) ;
-void flip1(SNP *cupt, int phasedmode, int flipreference) ;
-
-void fixaa(SNP *cupt1, SNP *cupt2) ;
-void fvalg(SNP *cupt, int val) ;
-char cxx(char *c1, char *c2) ;
-void downsamp(SNP *cupt) ;
-int setsamp(Indiv **indivmarkers, int numindivs, char *usesamples) ;
-
-
-
-int main(int argc, char **argv)
+SNP **snpmarkers;
+SNP **snpm2;
+int zerodistance = NO; // YES => force gdis 0
+int downsample = NO; // make pseudo homozygotes
+int pordercheck = YES;
+
+int numsnps, numindivs, numind2;
+int nums2;
+
+char *genotypename = NULL;
+char *genotypelist = NULL;
+
+char *snpname = NULL;
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *indivname = NULL;
+char *newindivname = NULL;
+char *badsnpname = NULL;
+char *xregionname = NULL;
+char *deletesnpoutname = NULL;
+char *flipsnpname = NULL;
+char *flipstrandname = NULL;
+int flipreference = YES;
+int remapcheck = YES;
+
+char *poplistname = NULL;
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+double maxmissfrac = 1000.0; // no thresh
+int maxmiss = -1; // no thresh
+int killr2 = NO;
+int mkdiploid = NO;
+
+int packout = -1;
+int tersem = YES;
+int randommode = NO;
+int seed = 0;
+
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+char *omode = "packedancestrymap";
+extern int packmode;
+int ogmode = NO;
+int fastdup = NO;
+int fastdupnum = 10;
+double fastdupthresh = .75;
+double fastdupkill = .75;
+char *polarid = NULL;
+int polarindex = -1;
+
+int phasedmode = NO;
+int badpedignore = NO;
+int chimpmode = NO;
+
+int xchrom = -1;
+int lopos = -999999999;
+int hipos = 999999999;
+int minchrom = 1;
+int maxchrom = 97;
+
+int deletedup = YES; // only one marker at a position
+char *newsnpname = NULL; // new map
+int newignore = YES; // default ignore snps not in old list
+int polarcheck = NO;
+int copyalleles = NO;
+
+char *usesamples = NULL;
+
+char unknowngender = 'U';
+double nhwfilter = -1;
+
+void
+setomode (enum outputmodetype *outmode, char *omode);
+void
+readcommands (int argc, char **argv);
+void
+outfiles (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numind, int packem, int ogmode);
+void
+remap (SNP **s1, int nums1, SNP **s2, int nums2);
+void
+remapind (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2,
+ int numindivs, int numind2);
+void
+pickx (SNP *c1, SNP *c2, SNP **px1, SNP **px2);
+void
+dedupit (SNP **snpmarkers, int numsnps);
+void
+flipsnps (char *fsname, SNP **snpm, int numsnps, int phasedmode);
+void
+flipstrand (char *fsname, SNP **snpm, int numsnps);
+int
+mkindh2d (Indiv **indivmarkers, Indiv ***pindm2, int numindivs);
+void
+remaph2d (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2,
+ int numindivs, int numind2);
+void
+flip1 (SNP *cupt, int phasedmode, int flipreference);
+
+void
+fixaa (SNP *cupt1, SNP *cupt2);
+void
+fvalg (SNP *cupt, int val);
+char
+cxx (char *c1, char *c2);
+void
+downsamp (SNP *cupt);
+int
+setsamp (Indiv **indivmarkers, int numindivs, char *usesamples);
+
+int
+main (int argc, char **argv)
{
- int **snppos ;
- int *snpindx ;
- char **snpnamelist, **indnamelist ;
- char **eglist ;
- int lsnplist, lindlist, numeg ;
- int i,j;
- SNP *cupt, *cupt1, *cupt2, *cupt3 ;
- Indiv *indx ;
- double gpos1,gpos2,cpos1,cpos2,gd, cd, gd100 ;
- double rthresh, zt ;
- int mpflag, ret, numvalidind, nvalid, numvalidsnps ;
-
- int ch1, ch2 ;
- int fmnum , lmnum ;
- int num, n1, n2 ;
- int nkill = 0 ;
- int t, k, g ;
-
- int nindiv = 0, e, f, lag=1 ;
- double xc[9], xd[4], xc2[9] ;
- double ychi, zscore, zthresh = 20.0 ;
- double y1, y2 ;
- int nignore, numrisks = 1 ;
-
- char **genolist ;
- int numgenolist ;
- char c1, c2 ;
- int t1, t2 ;
-
- malexhet = YES ; // convertf default is don't change the data
- tersem = YES ; // no snp counts
-
- readcommands(argc, argv) ;
-
- if (fastdup) randommode = YES ;
- if ((randommode) && (seed==0)) {
- seed = seednum() ;
- printf("seed: %d\n", seed) ;
- }
-
- if (randommode) SRAND(seed) ;
-
- if (chimpmode) {
- setchimpmode(YES) ;
- setchr(YES) ;
- }
-
- setomode(&outputmode, omode) ;
- packmode = YES ;
- settersemode(tersem) ;
-
- if (r2thresh > 0.0) killr2 = YES ;
- if (badpedignore) setbadpedignore() ;
-
- setpordercheck(pordercheck) ;
-
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
-
- for (i=0; i<numsnps; i++) {
- if (xchrom == -1) break ;
- cupt = snpmarkers[i] ;
- if (cupt -> chrom != xchrom) cupt -> ignore = YES ;
- if (cupt -> ignore) continue ;
- t = nnint(cupt -> physpos) ;
- if ( (t< lopos) || (t >hipos)) cupt -> ignore = YES ;
- }
-
- nignore = 0 ;
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (cupt -> chrom > maxchrom) cupt -> ignore = YES ;
- if (cupt -> chrom < minchrom) cupt -> ignore = YES ;
- if (cupt -> ignore) ++nignore ;
- }
-
-/**
- printf("zzqq %d %d\n", numsnps, nignore) ;
- return 0 ;
-*/
- if (numsnps == nignore) fatalx("no valid snps\n") ;
-
-
- numindivs = getindivs(indivname, &indivmarkers) ;
- if (polarid != NULL) {
- polarindex = indindex(indivmarkers, numindivs, polarid) ;
- if (polarindex<0) fatalx("polarid %s not found\n", polarid) ;
- }
-
- inddupcheck(indivmarkers, numindivs) ;
-
- if (genotypelist!= NULL) {
- getgenos_list(genotypelist, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
- }
-
- else {
- setgenotypename(&genotypename, indivname) ;
- getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
- }
-
- if (newsnpname != NULL) {
- numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
-// clean up before funky stuff
- clearsnpord() ;
- nums2 =
- getsnps(newsnpname, &snpm2, 0.0, NULL, &nignore, numrisks) ;
- remap(snpmarkers, numsnps, snpm2, nums2) ;
- snpmarkers = snpm2 ;
- numsnps = nums2 ;
- }
-
- if (newindivname != NULL) {
- numind2 = getindivs(newindivname, &indm2) ;
- remapind(snpmarkers, numsnps, indivmarkers, indm2, numindivs, numind2) ;
- indivmarkers = indm2 ;
- numindivs = numind2 ;
- if (polarid != NULL) {
- polarindex = indindex(indivmarkers, numindivs, polarid) ;
- }
- inddupcheck(indivmarkers, numindivs) ;
- }
-
- if (mkdiploid) {
-
- numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
- numind2 = mkindh2d(indivmarkers, &indm2, numindivs) ;
- remaph2d(snpmarkers, numsnps, indivmarkers, indm2, numindivs, numind2) ;
-
- indivmarkers = indm2 ;
- numindivs = numind2 ;
-
- }
-
-
- if (deletedup) dedupit(snpmarkers, numsnps) ; // only one marker per position
-
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (zerodistance) cupt -> genpos = 0.0 ;
-
- c1 = cupt -> alleles[0] ;
- c2 = cupt -> alleles[1] ;
- t1 = pedval(&c1) % 5 ;
- t2 = pedval(&c2) % 5 ; // 0 and 5 are no good
- if ((t1==0) && (t2 >0)) flip1(cupt, phasedmode, YES) ;
- }
-
- flipstrand(flipstrandname, snpmarkers, numsnps) ;
- flipsnps(flipsnpname, snpmarkers, numsnps, phasedmode) ;
-
- if (polarindex>=0) {
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- g = getgtypes(cupt, polarindex) ;
- if (g==0) {
- printf("polarizing %s\n", cupt -> ID) ;
- flip1(cupt, NO, YES) ;
- g = getgtypes(cupt, polarindex) ;
- if (g!=2) fatalx("badbug\n") ;
- }
- if (g != 2) cupt -> ignore = YES ;
- }
- }
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (downsample) downsamp(cupt) ;
- }
-
- if (outputall) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
-
- printf("##end of convertf run (outputall mode)\n") ;
+ int **snppos;
+ int *snpindx;
+ char **snpnamelist, **indnamelist;
+ char **eglist;
+ int lsnplist, lindlist, numeg;
+ int i, j;
+ SNP *cupt, *cupt1, *cupt2, *cupt3;
+ Indiv *indx;
+ double gpos1, gpos2, cpos1, cpos2, gd, cd, gd100;
+ double rthresh, zt;
+ int mpflag, ret, numvalidind, nvalid, numvalidsnps;
+
+ int ch1, ch2;
+ int fmnum, lmnum;
+ int num, n1, n2;
+ int nkill = 0;
+ int t, k, g;
+
+ int nindiv = 0, e, f, lag = 1;
+ double xc[9], xd[4], xc2[9];
+ double ychi, zscore, zthresh = 20.0;
+ double y1, y2;
+ int nignore, numrisks = 1;
+
+ char **genolist;
+ int numgenolist;
+ char c1, c2;
+ int t1, t2;
+
+ malexhet = YES; // convertf default is don't change the data
+ tersem = YES; // no snp counts
+
+ readcommands (argc, argv);
+
+ if (fastdup)
+ randommode = YES;
+ if ((randommode) && (seed == 0))
+ {
+ seed = seednum ();
+ printf ("seed: %d\n", seed);
+ }
+
+ if (randommode)
+ SRAND (seed);
+
+ if (chimpmode)
+ {
+ setchimpmode (YES);
+ setchr (YES);
+ }
+
+ setomode (&outputmode, omode);
+ packmode = YES;
+ settersemode (tersem);
+
+ if (r2thresh > 0.0)
+ killr2 = YES;
+ if (badpedignore)
+ setbadpedignore ();
+
+ setpordercheck (pordercheck);
+
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+
+ for (i = 0; i < numsnps; i++)
+ {
+ if (xchrom == -1)
+ break;
+ cupt = snpmarkers[i];
+ if (cupt->chrom != xchrom)
+ cupt->ignore = YES;
+ if (cupt->ignore)
+ continue;
+ t = nnint (cupt->physpos);
+ if ((t < lopos) || (t > hipos))
+ cupt->ignore = YES;
+ }
+
+ nignore = 0;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->chrom > maxchrom)
+ cupt->ignore = YES;
+ if (cupt->chrom < minchrom)
+ cupt->ignore = YES;
+ if (cupt->ignore)
+ ++nignore;
+ }
+
+ /**
+ printf("zzqq %d %d\n", numsnps, nignore) ;
return 0 ;
- }
-
- if (usesamples != NULL) {
- poplistname = NULL ;
- setsamp(indivmarkers, numindivs, usesamples) ;
-
-
- }
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- if (indx -> affstatus == NO) indx -> ignore = YES ;
- }
- }
- else
- setstatus(indivmarkers, numindivs, "Case") ;
-
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ;
- numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
-
-
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
-
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
-
-
- numvalidind = 0 ;
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- if (numvalidgtind(snpmarkers, numsnps, i) ==0) {
- indx -> ignore = YES ;
- printf("no data for individual: %s\n", indx -> ID) ;
- }
- if (indx -> ignore == NO) ++numvalidind ;
- }
-
- if (maxmiss<0) maxmiss = (int) (maxmissfrac * (double) numvalidind+1) ;
- printf("numvalidind: %5d maxmiss: %5d\n", numvalidind, maxmiss) ;
- if (numvalidind == 0) fatalx("no valid samples!\n") ;
-
- for (k=0; k<numsnps; ++k) {
- if (maxmiss>numvalidind) break ;
- cupt = snpmarkers[k] ;
- t = numvalidind - numvalidgtypes(cupt) ;
+ */
+ if (numsnps == nignore)
+ fatalx ("no valid snps\n");
+
+ numindivs = getindivs (indivname, &indivmarkers);
+ if (polarid != NULL)
+ {
+ polarindex = indindex (indivmarkers, numindivs, polarid);
+ if (polarindex < 0)
+ fatalx ("polarid %s not found\n", polarid);
+ }
+
+ inddupcheck (indivmarkers, numindivs);
+
+ if (genotypelist != NULL)
+ {
+ getgenos_list (genotypelist, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
+ }
+
+ else
+ {
+ setgenotypename (&genotypename, indivname);
+ getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
+ }
+
+ if (newsnpname != NULL)
+ {
+ numindivs = rmindivs (snpmarkers, numsnps, indivmarkers, numindivs);
+// clean up before funky stuff
+ clearsnpord ();
+ nums2 = getsnps (newsnpname, &snpm2, 0.0, NULL, &nignore, numrisks);
+ remap (snpmarkers, numsnps, snpm2, nums2);
+ snpmarkers = snpm2;
+ numsnps = nums2;
+ }
+
+ if (newindivname != NULL)
+ {
+ numind2 = getindivs (newindivname, &indm2);
+ remapind (snpmarkers, numsnps, indivmarkers, indm2, numindivs, numind2);
+ indivmarkers = indm2;
+ numindivs = numind2;
+ if (polarid != NULL)
+ {
+ polarindex = indindex (indivmarkers, numindivs, polarid);
+ }
+ inddupcheck (indivmarkers, numindivs);
+ }
+
+ if (mkdiploid)
+ {
+
+ numindivs = rmindivs (snpmarkers, numsnps, indivmarkers, numindivs);
+ numind2 = mkindh2d (indivmarkers, &indm2, numindivs);
+ remaph2d (snpmarkers, numsnps, indivmarkers, indm2, numindivs, numind2);
+
+ indivmarkers = indm2;
+ numindivs = numind2;
+
+ }
+
+ if (deletedup)
+ dedupit (snpmarkers, numsnps); // only one marker per position
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (zerodistance)
+ cupt->genpos = 0.0;
+
+ c1 = cupt->alleles[0];
+ c2 = cupt->alleles[1];
+ t1 = pedval (&c1) % 5;
+ t2 = pedval (&c2) % 5; // 0 and 5 are no good
+ if ((t1 == 0) && (t2 > 0))
+ flip1 (cupt, phasedmode, YES);
+ }
+
+ flipstrand (flipstrandname, snpmarkers, numsnps);
+ flipsnps (flipsnpname, snpmarkers, numsnps, phasedmode);
+
+ if (polarindex >= 0)
+ {
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ g = getgtypes (cupt, polarindex);
+ if (g == 0)
+ {
+ printf ("polarizing %s\n", cupt->ID);
+ flip1 (cupt, NO, YES);
+ g = getgtypes (cupt, polarindex);
+ if (g != 2)
+ fatalx ("badbug\n");
+ }
+ if (g != 2)
+ cupt->ignore = YES;
+ }
+ }
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (downsample)
+ downsamp (cupt);
+ }
+
+ if (outputall)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+
+ printf ("##end of convertf run (outputall mode)\n");
+ return 0;
+ }
+
+ if (usesamples != NULL)
+ {
+ poplistname = NULL;
+ setsamp (indivmarkers, numindivs, usesamples);
+
+ }
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == NO)
+ indx->ignore = YES;
+ }
+ }
+ else
+ setstatus (indivmarkers, numindivs, "Case");
+
+ numsnps = rmsnps (snpmarkers, numsnps, deletesnpoutname);
+ numindivs = rmindivs (snpmarkers, numsnps, indivmarkers, numindivs);
+
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
+
+ if (nhwfilter > 0)
+ {
+ hwfilter (snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
+ }
+
+ if (xregionname)
+ {
+ excluderegions (xregionname, snpmarkers, numsnps, deletesnpoutname);
+ }
+
+ numvalidind = 0;
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ if (numvalidgtind (snpmarkers, numsnps, i) == 0)
+ {
+ indx->ignore = YES;
+ printf ("no data for individual: %s\n", indx->ID);
+ }
+ if (indx->ignore == NO)
+ ++numvalidind;
+ }
+
+ if (maxmiss < 0)
+ maxmiss = (int) (maxmissfrac * (double) numvalidind + 1);
+ printf ("numvalidind: %5d maxmiss: %5d\n", numvalidind, maxmiss);
+ if (numvalidind == 0)
+ fatalx ("no valid samples!\n");
+
+ for (k = 0; k < numsnps; ++k)
+ {
+ if (maxmiss > numvalidind)
+ break;
+ cupt = snpmarkers[k];
+ t = numvalidind - numvalidgtypes (cupt);
// printf("zz %20s %4d %4d\n", cupt -> ID, t, numvalidind-t) ;
- if (maxmiss < t) {
- cupt -> ignore = YES ;
- }
-/**
- if (numvalidind == t) {
- printf("no data for snp: %s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- }
-*/
-
- }
-
- if (fastdup) {
-
- printf("fastdup set %d\n", fastdupnum) ;
- if (fastdupnum > 0) {
- setfastdupnum(fastdupnum) ;
- setfastdupthresh(fastdupthresh, fastdupkill) ;
- fastdupcheck(snpmarkers, indivmarkers, numsnps, numindivs) ;
- }
- }
-
- if (decim>0) {
- snpdecimate(snpmarkers, numsnps, decim, dmindis, dmaxdis) ;
- }
-
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
-
- printf("##end of convertf run\n") ;
- return 0 ;
+ if (maxmiss < t)
+ {
+ cupt->ignore = YES;
+ }
+ /**
+ if (numvalidind == t) {
+ printf("no data for snp: %s\n", cupt -> ID) ;
+ cupt -> ignore = YES ;
+ }
+ */
+
+ }
+
+ if (fastdup)
+ {
+
+ printf ("fastdup set %d\n", fastdupnum);
+ if (fastdupnum > 0)
+ {
+ setfastdupnum (fastdupnum);
+ setfastdupthresh (fastdupthresh, fastdupkill);
+ fastdupcheck (snpmarkers, indivmarkers, numsnps, numindivs);
+ }
+ }
+
+ if (decim > 0)
+ {
+ snpdecimate (snpmarkers, numsnps, decim, dmindis, dmaxdis);
+ }
+
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+
+ printf ("##end of convertf run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i,haploid=0;
- char *parname = NULL ;
- phandle *ph ;
- char str[5000] ;
- char *tempname ;
- int n ;
-
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
-/**
-DIR2: /fg/nfiles/admixdata/ms2
-SSSS: DIR2/outfiles
-genotypename: DIR2/autos_ccshad_fakes
-eglistname: DIR2/eurlist
-output: eurout
-*/
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "genotypelist:", &genotypelist) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "flipsnpname:", &flipsnpname) ;
- getstring(ph, "flipstrandname:", &flipstrandname) ;
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getstring(ph, "polarize:", &polarid) ;
- getstring(ph, "usesamples:", &usesamples) ;
- getint(ph, "zerodistance:", &zerodistance) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "badpedignore:", &badpedignore) ;
- getint(ph, "downsample:", &downsample) ;
- getint(ph, "chimpmode:", &chimpmode) ;
- getint(ph, "pordercheck:", &pordercheck) ;
- getint(ph, "remapcheck:", &remapcheck) ;
- getint(ph, "seed:", &seed) ;
- getint(ph, "randommode:", &randommode) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
- getstring(ph, "deletesnpoutname:", &deletesnpoutname);
-
- getint(ph, "outputgroup:", &ogmode) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "tersemode:", &tersem) ;
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getint(ph, "decimate:", &decim) ;
- getint(ph, "dmindis:", &dmindis) ;
- getint(ph, "dmaxdis:", &dmaxdis) ;
- getint(ph, "fastdup:", &fastdup) ;
- getint(ph, "flipreference:", &flipreference) ;
- getint(ph, "fastdupnum:", &fastdupnum) ;
- getdbl(ph, "fastdupthresh:", &fastdupthresh) ;
- getdbl(ph, "fastdupkill:", &fastdupkill) ;
- getint(ph, "killr2:", &killr2) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "outputall:", &outputall) ;
- getint(ph, "sevencolumnped:", &sevencolumnped) ;
- getint(ph, "phasedmode:", &phasedmode) ;
- getint(ph, "polarcheck:", &polarcheck) ;
- getint(ph, "copyalleles:", ©alleles) ;
+ int i, haploid = 0;
+ char *parname = NULL;
+ phandle *ph;
+ char str[5000];
+ char *tempname;
+ int n;
+
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
+
+ switch (i)
+ {
+
+ case 'p':
+ parname = strdup (optarg);
+ break;
+
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
+
+ case 'V':
+ verbose = YES;
+ break;
+
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
+
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ /**
+ DIR2: /fg/nfiles/admixdata/ms2
+ SSSS: DIR2/outfiles
+ genotypename: DIR2/autos_ccshad_fakes
+ eglistname: DIR2/eurlist
+ output: eurout
+ */
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "genotypelist:", &genotypelist);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "flipsnpname:", &flipsnpname);
+ getstring (ph, "flipstrandname:", &flipstrandname);
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getstring (ph, "polarize:", &polarid);
+ getstring (ph, "usesamples:", &usesamples);
+ getint (ph, "zerodistance:", &zerodistance);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "badpedignore:", &badpedignore);
+ getint (ph, "downsample:", &downsample);
+ getint (ph, "chimpmode:", &chimpmode);
+ getint (ph, "pordercheck:", &pordercheck);
+ getint (ph, "remapcheck:", &remapcheck);
+ getint (ph, "seed:", &seed);
+ getint (ph, "randommode:", &randommode);
+
+ getint (ph, "numchrom:", &numchrom);
+ getstring (ph, "xregionname:", &xregionname);
+ getdbl (ph, "hwfilter:", &nhwfilter);
+ getstring (ph, "deletesnpoutname:", &deletesnpoutname);
+
+ getint (ph, "outputgroup:", &ogmode);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "tersemode:", &tersem);
+ getint (ph, "familynames:", &familynames);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getint (ph, "decimate:", &decim);
+ getint (ph, "dmindis:", &dmindis);
+ getint (ph, "dmaxdis:", &dmaxdis);
+ getint (ph, "fastdup:", &fastdup);
+ getint (ph, "flipreference:", &flipreference);
+ getint (ph, "fastdupnum:", &fastdupnum);
+ getdbl (ph, "fastdupthresh:", &fastdupthresh);
+ getdbl (ph, "fastdupkill:", &fastdupkill);
+ getint (ph, "killr2:", &killr2);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "outputall:", &outputall);
+ getint (ph, "sevencolumnped:", &sevencolumnped);
+ getint (ph, "phasedmode:", &phasedmode);
+ getint (ph, "polarcheck:", &polarcheck);
+ getint (ph, "copyalleles:", ©alleles);
// we assume with newsnpname we are (A,B) in S1 and (A, B) or (rev(A), rev(B)) in S2
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
-
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
-
- getint(ph, "minchrom:", &minchrom) ;
- getint(ph, "maxchrom:", &maxchrom) ;
- getdbl(ph, "maxmissfrac:", &maxmissfrac) ;
- getint(ph, "maxmissing:", &maxmiss) ;
-
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "newsnpname:", &newsnpname) ;
- getint(ph, "newignore:", &newignore) ;
- getstring(ph, "newindivname:", &newindivname) ;
- getint(ph, "deletedup:", &deletedup) ;
- getint(ph, "mkdiploid:", &mkdiploid) ;
-
- writepars(ph) ;
- closepars(ph) ;
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+
+ getint (ph, "minchrom:", &minchrom);
+ getint (ph, "maxchrom:", &maxchrom);
+ getdbl (ph, "maxmissfrac:", &maxmissfrac);
+ getint (ph, "maxmissing:", &maxmiss);
+
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "newsnpname:", &newsnpname);
+ getint (ph, "newignore:", &newignore);
+ getstring (ph, "newindivname:", &newindivname);
+ getint (ph, "deletedup:", &deletedup);
+ getint (ph, "mkdiploid:", &mkdiploid);
+
+ writepars (ph);
+ closepars (ph);
}
-void remap(SNP **s1, int nums1, SNP **s2, int nums2)
+void
+remap (SNP **s1, int nums1, SNP **s2, int nums2)
{
- SNP *cupt1, *cupt2 ;
- SNP tcupt, *cupt ;
- int i, k ;
-
- for (i=0; i<nums2; ++i) {
- cupt2 = s2[i] ;
- k = snpindex(s1, nums1, cupt2 -> ID) ;
- if (k<0) {
- printf("%20s not found\n", cupt2 -> ID) ;
- if (newignore) {
- cupt2 -> ignore = YES ;
- }
- continue ;
- }
- cupt1 = s1[k] ;
-
- if (copyalleles) {
- cupt2 -> alleles[0] = cupt1 -> alleles[0] ;
- cupt2 -> alleles[1] = cupt1 -> alleles[1] ;
- }
-
- fixaa(cupt1, cupt2) ;
- if (cupt1 -> alleles[1] == 'X') {
- cupt1 -> alleles[1] = cxx(cupt1 -> alleles, cupt2 -> alleles) ;
- }
- tcupt = *cupt2 ;
- *cupt2 = *cupt1 ;
- cupt = &tcupt ;
- cupt2 -> chrom = cupt -> chrom ;
- cupt2 -> genpos = cupt -> genpos ;
- cupt2 -> physpos = cupt -> physpos ;
- cupt2 -> alleles[0] = cupt -> alleles[0] ;
- cupt2 -> alleles[1] = cupt -> alleles[1] ;
- }
- freesnpindex() ;
+ SNP *cupt1, *cupt2;
+ SNP tcupt, *cupt;
+ int i, k;
+
+ for (i = 0; i < nums2; ++i)
+ {
+ cupt2 = s2[i];
+ k = snpindex (s1, nums1, cupt2->ID);
+ if (k < 0)
+ {
+ printf ("%20s not found\n", cupt2->ID);
+ if (newignore)
+ {
+ cupt2->ignore = YES;
+ }
+ continue;
+ }
+ cupt1 = s1[k];
+
+ if (copyalleles)
+ {
+ cupt2->alleles[0] = cupt1->alleles[0];
+ cupt2->alleles[1] = cupt1->alleles[1];
+ }
+
+ fixaa (cupt1, cupt2);
+ if (cupt1->alleles[1] == 'X')
+ {
+ cupt1->alleles[1] = cxx (cupt1->alleles, cupt2->alleles);
+ }
+ tcupt = *cupt2;
+ *cupt2 = *cupt1;
+ cupt = &tcupt;
+ cupt2->chrom = cupt->chrom;
+ cupt2->genpos = cupt->genpos;
+ cupt2->physpos = cupt->physpos;
+ cupt2->alleles[0] = cupt->alleles[0];
+ cupt2->alleles[1] = cupt->alleles[1];
+ }
+ freesnpindex ();
}
-char cxx(char *c1, char *c2)
+char
+cxx (char *c1, char *c2)
{
- if (c1[0] == c2[0]) return c2[1] ;
- if (c1[0] == c2[1]) return c2[0] ;
+ if (c1[0] == c2[0])
+ return c2[1];
+ if (c1[0] == c2[1])
+ return c2[0];
}
-void fixaa(SNP *cupt1, SNP *cupt2)
+void
+fixaa (SNP *cupt1, SNP *cupt2)
{
- char *c1, *c2 ;
- int t, ok ;
- char cc1, cc2 ;
-
- if (remapcheck == NO) return ;
- c1 = cupt1 -> alleles ;
- c2 = cupt2 -> alleles ;
-
- if ((c1[1] == 'X') && (c1[0] == c2[0])) c1[1] = c2[1] ;
- if ((c1[1] == 'X') && (c1[0] == c2[1])) c1[1] = c2[0] ;
- if ((c2[1] == 'X') && (c1[0] == c2[0])) c2[1] = c1[1] ;
- if ((c2[1] == 'X') && (c1[1] == c2[0])) c2[1] = c1[0] ;
- if ((c1[0] == c2[0]) && (c1[1] == c2[1])) return ;
- if (polarcheck) {
- ok = YES ;
- cc1 = toupper(c1[0]) ;
- cc2 = toupper(c2[0]) ;
- if (cc2!=revchar(cc1)) ok = NO ;
- cc1 = toupper(c1[1]) ;
- cc2 = toupper(c2[1]) ;
- if (cc2!=revchar(cc1)) ok = NO ;
- if (ok==NO) {
- printf("forcing all genos invalid for %s %c %c %c %c\n",cupt1 -> ID, c1[0], c1[1], c2[0], c2[1]) ;
- fvalg(cupt1, 999) ;
- cupt1 -> ignore = YES;
- return ;
- }
- c1[0] = c2[0] ;
- c1[1] = c2[1] ;
- }
-
- if ((c1[0] == c2[1]) && (c1[1] == c2[0])) {
- flip1(cupt1, phasedmode, YES) ;
- return ;
- }
- t = 999 ;
- if ((c1[0] == c2[0]) && (c1[1] != c2[1])) {
- t = 2 ;
- if (phasedmode) t=1 ;
- }
- if ((c1[1] == c2[1]) && (c1[0] != c2[0])) {
- t = 0 ;
- fvalg(cupt1, 0) ; // only valid genotype ;
- return ;
- }
- fvalg(cupt1, t) ; // force all snps invalid
- if (t==999) {
- printf("forcing all genos invalid for %s %c %c %c %c\n",cupt1 -> ID, c1[0], c1[1], c2[0], c2[1]) ;
- }
-}
+ char *c1, *c2;
+ int t, ok;
+ char cc1, cc2;
+
+ if (remapcheck == NO)
+ return;
+ c1 = cupt1->alleles;
+ c2 = cupt2->alleles;
+
+ if ((c1[1] == 'X') && (c1[0] == c2[0]))
+ c1[1] = c2[1];
+ if ((c1[1] == 'X') && (c1[0] == c2[1]))
+ c1[1] = c2[0];
+ if ((c2[1] == 'X') && (c1[0] == c2[0]))
+ c2[1] = c1[1];
+ if ((c2[1] == 'X') && (c1[1] == c2[0]))
+ c2[1] = c1[0];
+ if ((c1[0] == c2[0]) && (c1[1] == c2[1]))
+ return;
+ if (polarcheck)
+ {
+ ok = YES;
+ cc1 = toupper(c1[0]);
+ cc2 = toupper(c2[0]);
+ if (cc2 != revchar (cc1))
+ ok = NO;
+ cc1 = toupper(c1[1]);
+ cc2 = toupper(c2[1]);
+ if (cc2 != revchar (cc1))
+ ok = NO;
+ if (ok == NO)
+ {
+ printf ("forcing all genos invalid for %s %c %c %c %c\n",
+ cupt1->ID, c1[0], c1[1], c2[0], c2[1]);
+ fvalg (cupt1, 999);
+ cupt1->ignore = YES;
+ return;
+ }
+ c1[0] = c2[0];
+ c1[1] = c2[1];
+ }
-void downsamp(SNP *cupt)
-{
- int k, g, t, g2 ;
- static int ncall = 0 ;
-
- ++ncall ;
- if (ncall == 1) {
- SRAND(77) ;
- printf("downsample set\n") ;
- }
-
- for (k=0; k<numindivs; ++k) {
- g = getgtypes(cupt, k) ;
- if (g == 1 ) {
- t = ranmod(2) ;
- putgtypes(cupt, k, 2*t) ;
- }
- }
+ if ((c1[0] == c2[1]) && (c1[1] == c2[0]))
+ {
+ flip1 (cupt1, phasedmode, YES);
+ return;
+ }
+ t = 999;
+ if ((c1[0] == c2[0]) && (c1[1] != c2[1]))
+ {
+ t = 2;
+ if (phasedmode)
+ t = 1;
+ }
+ if ((c1[1] == c2[1]) && (c1[0] != c2[0]))
+ {
+ t = 0;
+ fvalg (cupt1, 0); // only valid genotype ;
+ return;
+ }
+ fvalg (cupt1, t); // force all snps invalid
+ if (t == 999)
+ {
+ printf ("forcing all genos invalid for %s %c %c %c %c\n", cupt1->ID,
+ c1[0], c1[1], c2[0], c2[1]);
+ }
}
-void fvalg(SNP *cupt, int val)
+void
+downsamp (SNP *cupt)
{
- int k, g ;
+ int k, g, t, g2;
+ static int ncall = 0;
+
+ ++ncall;
+ if (ncall == 1)
+ {
+ SRAND (77);
+ printf ("downsample set\n");
+ }
- for (k=0; k<numindivs; ++k) {
- g = getgtypes(cupt, k) ;
- if (g != val) putgtypes(cupt, k, -1) ;
- }
+ for (k = 0; k < numindivs; ++k)
+ {
+ g = getgtypes (cupt, k);
+ if (g == 1)
+ {
+ t = ranmod (2);
+ putgtypes (cupt, k, 2 * t);
+ }
+ }
}
-
-void
-remapind(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2, int numindivs, int numind2)
-
+void
+fvalg (SNP *cupt, int val)
{
+ int k, g;
- int *g1, *g2, *w1 ;
- int *tind, t, i, j, k ;
- Indiv *indx ;
- SNP *cupt ;
-
- if (numindivs != numind2) fatalx("different remapind sizes %d %d\n", numindivs, numind2) ;
- ZALLOC(tind, numind2, int) ;
- ZALLOC(g2, numind2, int) ;
- ZALLOC(g1, numind2, int) ;
- ZALLOC(w1, numind2, int) ;
-
- for (k=0; k<numind2; ++k) {
- indx = indm2[k] ;
- t = tind[k] = indindex(indivmarkers, numindivs, indx -> ID) ;
- if (t<0) fatalx("bad newindiv: %s\n", indx -> ID) ;
- }
-
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
+ for (k = 0; k < numindivs; ++k)
+ {
+ g = getgtypes (cupt, k);
+ if (g != val)
+ putgtypes (cupt, k, -1);
+ }
+}
- for (j=0; j<numind2; ++j) {
- g1[j] = getgtypes(cupt, j) ;
- }
- copyiarr(g1, w1, numind2) ;
+void
+remapind (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2,
+ int numindivs, int numind2)
- for (k=0; k< numind2; ++k) {
- g2[k] = g1[tind[k]] ;
- }
+{
- ivclear(g1, -1, numind2) ;
- copyiarr(g2, g1, numind2) ;
+ int *g1, *g2, *w1;
+ int *tind, t, i, j, k;
+ Indiv *indx;
+ SNP *cupt;
+
+ if (numindivs != numind2)
+ fatalx ("different remapind sizes %d %d\n", numindivs, numind2);
+ ZALLOC(tind, numind2, int);
+ ZALLOC(g2, numind2, int);
+ ZALLOC(g1, numind2, int);
+ ZALLOC(w1, numind2, int);
+
+ for (k = 0; k < numind2; ++k)
+ {
+ indx = indm2[k];
+ t = tind[k] = indindex (indivmarkers, numindivs, indx->ID);
+ if (t < 0)
+ fatalx ("bad newindiv: %s\n", indx->ID);
+ }
- for (k=0; k<numind2; ++k) {
- putgtypes(cupt, k, g1[k]) ;
- }
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+
+ for (j = 0; j < numind2; ++j)
+ {
+ g1[j] = getgtypes (cupt, j);
+ }
+ copyiarr (g1, w1, numind2);
+
+ for (k = 0; k < numind2; ++k)
+ {
+ g2[k] = g1[tind[k]];
+ }
+
+ ivclear (g1, -1, numind2);
+ copyiarr (g2, g1, numind2);
+
+ for (k = 0; k < numind2; ++k)
+ {
+ putgtypes (cupt, k, g1[k]);
+ }
+
+ /**
+ if (i<100) {
+ printf("zzz %s\n", cupt -> ID) ;
+ for (j=0; j<numind2; ++j) {
+ g1[j] = getgtypes(cupt, j) ;
+ }
+ printimat(w1, 1, numind2) ;
+ printimat(g1, 1, numind2) ;
+ }
+ */
-/**
- if (i<100) {
- printf("zzz %s\n", cupt -> ID) ;
- for (j=0; j<numind2; ++j) {
- g1[j] = getgtypes(cupt, j) ;
}
- printimat(w1, 1, numind2) ;
- printimat(g1, 1, numind2) ;
- }
-*/
- }
-
- free(w1) ;
- free(g1) ;
- free(g2) ;
- free(tind) ;
+ free (w1);
+ free (g1);
+ free (g2);
+ free (tind);
}
-
-
-void dedupit(SNP **snpmarkers, int numsnps)
+void
+dedupit (SNP **snpmarkers, int numsnps)
{
- SNP *cupt1, *cupt2 ;
- SNP *x1, *x2 ;
- int k ;
-
- cupt1 = NULL ;
-
- for (k=0; k<numsnps; ++k) {
- cupt2 = snpmarkers[k] ;
- if (cupt2 -> ignore) continue ;
- if (cupt1 == NULL) {
- cupt1 = cupt2 ;
- continue ;
- }
- if (cupt1 -> chrom != cupt2 -> chrom) {
- cupt1 = cupt2 ;
- continue ;
- }
- if (cupt1 -> physpos != cupt2 -> physpos) {
- cupt1 = cupt2 ;
- continue ;
- }
- pickx(cupt1, cupt2, &x1, &x2) ; // x2 bad
- x2 -> ignore = YES ;
- cupt1 = x1 ;
- }
+ SNP *cupt1, *cupt2;
+ SNP *x1, *x2;
+ int k;
+
+ cupt1 = NULL;
+
+ for (k = 0; k < numsnps; ++k)
+ {
+ cupt2 = snpmarkers[k];
+ if (cupt2->ignore)
+ continue;
+ if (cupt1 == NULL)
+ {
+ cupt1 = cupt2;
+ continue;
+ }
+ if (cupt1->chrom != cupt2->chrom)
+ {
+ cupt1 = cupt2;
+ continue;
+ }
+ if (cupt1->physpos != cupt2->physpos)
+ {
+ cupt1 = cupt2;
+ continue;
+ }
+ pickx (cupt1, cupt2, &x1, &x2); // x2 bad
+ x2->ignore = YES;
+ cupt1 = x1;
+ }
}
-void pickx(SNP *c1, SNP *c2, SNP **px1, SNP **px2)
+void
+pickx (SNP *c1, SNP *c2, SNP **px1, SNP **px2)
{
// *px1 is retained *px2 dropped; Try and keep shorter rsnames (strip AFFX for instance)
- char *ch1, *ch2 ;
- int l1, l2, t ;
-
- ch1 = c1 -> ID ;
- ch2 = c2 -> ID ;
- l1 = strlen(ch1) ;
- l2 = strlen(ch2) ;
-
- if (l1<l2) {
- *px2 = c2 ;
- *px1 = c1 ;
- return ;
- }
- if (l2<l1) {
- *px2 = c1 ;
- *px1 = c2 ;
- return ;
- }
- t = strcmp(ch1, ch2) ;
- if (t>=0) {
- *px2 = c2 ;
- *px1 = c1 ;
- return ;
- }
- *px2 = c1 ;
- *px1 = c2 ;
- return ;
+ char *ch1, *ch2;
+ int l1, l2, t;
+
+ ch1 = c1->ID;
+ ch2 = c2->ID;
+ l1 = strlen (ch1);
+ l2 = strlen (ch2);
+
+ if (l1 < l2)
+ {
+ *px2 = c2;
+ *px1 = c1;
+ return;
+ }
+ if (l2 < l1)
+ {
+ *px2 = c1;
+ *px1 = c2;
+ return;
+ }
+ t = strcmp (ch1, ch2);
+ if (t >= 0)
+ {
+ *px2 = c2;
+ *px1 = c1;
+ return;
+ }
+ *px2 = c1;
+ *px1 = c2;
+ return;
}
-void flipstrand(char *fsname, SNP **snpm, int numsnps)
+void
+flipstrand (char *fsname, SNP **snpm, int numsnps)
// move alleles to opposite strand
{
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *ss ;
- int nsplit, n, k ;
- SNP *cupt ;
-
- if (fsname == NULL) return ;
- openit (fsname, &fff, "r") ;
-
- freesnpindex() ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- if (spt[0][0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- k = snpindex(snpm, numsnps, spt[0]) ;
- if (k>=0) {
- cupt = snpm[k] ;
- cupt -> alleles[0] = compbase(cupt -> alleles[0]) ;
- cupt -> alleles[1] = compbase(cupt -> alleles[1]) ;
- }
- freeup(spt, nsplit) ;
- }
- fclose (fff) ;
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *ss;
+ int nsplit, n, k;
+ SNP *cupt;
+
+ if (fsname == NULL)
+ return;
+ openit (fsname, &fff, "r");
+
+ freesnpindex ();
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ if (spt[0][0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ k = snpindex (snpm, numsnps, spt[0]);
+ if (k >= 0)
+ {
+ cupt = snpm[k];
+ cupt->alleles[0] = compbase (cupt->alleles[0]);
+ cupt->alleles[1] = compbase (cupt->alleles[1]);
+ }
+ freeup (spt, nsplit);
+ }
+ fclose (fff);
}
-void flipsnps(char *fsname, SNP **snpm, int numsnps, int phasedmode)
+void
+flipsnps (char *fsname, SNP **snpm, int numsnps, int phasedmode)
{
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *ss ;
- int nsplit, n, k ;
- SNP *cupt ;
-
- if (fsname == NULL) return ;
- openit (fsname, &fff, "r") ;
-
- freesnpindex() ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- if (spt[0][0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- k = snpindex(snpm, numsnps, spt[0]) ;
- if (k>=0) {
- flip1(snpm[k], phasedmode, flipreference) ;
- }
- freeup(spt, nsplit) ;
- }
- fclose (fff) ;
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *ss;
+ int nsplit, n, k;
+ SNP *cupt;
+
+ if (fsname == NULL)
+ return;
+ openit (fsname, &fff, "r");
+
+ freesnpindex ();
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ if (spt[0][0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ k = snpindex (snpm, numsnps, spt[0]);
+ if (k >= 0)
+ {
+ flip1 (snpm[k], phasedmode, flipreference);
+ }
+ freeup (spt, nsplit);
+ }
+ fclose (fff);
}
-void flip1(SNP *cupt, int phasedmode, int flipreference)
+void
+flip1 (SNP *cupt, int phasedmode, int flipreference)
{
- if (phasedmode == NO) flipalleles(cupt) ;
- if (phasedmode == YES) flipalleles_phased(cupt) ;
+ if (phasedmode == NO)
+ flipalleles (cupt);
+ if (phasedmode == YES)
+ flipalleles_phased (cupt);
// just flips genotypes
- if (flipreference) cswap(&cupt -> alleles[0], &cupt -> alleles[1]) ;
+ if (flipreference)
+ cswap (&cupt->alleles[0], &cupt->alleles[1]);
}
-void setsamplist(Indiv **indivmarkers, int numindivs, char **samplist, int nsplit)
+void
+setsamplist (Indiv **indivmarkers, int numindivs, char **samplist, int nsplit)
{
- int i, j, k ;
- Indiv *indx ;
- int t = 0 ;
-
- setstatusv(indivmarkers, numindivs, NULL, NO) ; // set affstatus to NO
-
- for (j=0; j<nsplit; ++j) {
- k = indindex(indivmarkers, numindivs, samplist[j]) ;
- if (k<0) {
- printf("*** warning: sample ID: %s not found\n", samplist[j]) ;
- continue ;
+ int i, j, k;
+ Indiv *indx;
+ int t = 0;
+
+ setstatusv (indivmarkers, numindivs, NULL, NO); // set affstatus to NO
+
+ for (j = 0; j < nsplit; ++j)
+ {
+ k = indindex (indivmarkers, numindivs, samplist[j]);
+ if (k < 0)
+ {
+ printf ("*** warning: sample ID: %s not found\n", samplist[j]);
+ continue;
+ }
+ indx = indivmarkers[k];
+ indx->affstatus = YES;
}
- indx = indivmarkers[k] ;
- indx -> affstatus = YES ;
- }
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- if (indx -> affstatus == NO) indx -> ignore = YES ;
- if (indx -> ignore == NO) ++t ;
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == NO)
+ indx->ignore = YES;
+ if (indx->ignore == NO)
+ ++t;
}
- if (t==0) fatalx("(setsamplist) no valids\n") ;
+ if (t == 0)
+ fatalx ("(setsamplist) no valids\n");
}
int
-setsamp(Indiv **indivmarkers, int numindivs, char *usesamples)
+setsamp (Indiv **indivmarkers, int numindivs, char *usesamples)
{
- char *spt[MAXFF] ;
- int nsplit ;
+ char *spt[MAXFF];
+ int nsplit;
- nsplit = splitupx(usesamples, spt, MAXFF, ':') ;
+ nsplit = splitupx (usesamples, spt, MAXFF, ':');
- setsamplist(indivmarkers, numindivs, spt, nsplit) ;
+ setsamplist (indivmarkers, numindivs, spt, nsplit);
- freeup(spt, nsplit) ;
+ freeup (spt, nsplit);
- return nsplit ;
+ return nsplit;
}
diff --git a/src/egsubs.c b/src/egsubs.c
index 8972403..32a800e 100644
--- a/src/egsubs.c
+++ b/src/egsubs.c
@@ -1,145 +1,175 @@
#include "mcio.h"
#include "egsubs.h"
-
-int makeeglist(char **eglist, int maxnumeg, Indiv **indivmarkers, int numindivs)
+int
+makeeglist (char **eglist, int maxnumeg, Indiv **indivmarkers, int numindivs)
// old routine mkeglist
{
- Indiv *indx ;
- int i, k, numeg=0 ;
- for (i=0; i<numindivs; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- k = indxindex(eglist, numeg, indx->egroup) ;
- if (k<0) {
- if (numeg >= maxnumeg) {
- printf("number of populations too large. Increase maxpops if you wish\n") ;
- fatalx("(makeeglist) You really want to analyse more than %d populations?\n", maxnumeg) ;
- }
- eglist[numeg] = strdup(indx->egroup) ;
- ++numeg ;
+ Indiv *indx;
+ int i, k, numeg = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ k = indxindex (eglist, numeg, indx->egroup);
+ if (k < 0)
+ {
+ if (numeg >= maxnumeg)
+ {
+ printf (
+ "number of populations too large. Increase maxpops if you wish\n");
+ fatalx (
+ "(makeeglist) You really want to analyse more than %d populations?\n",
+ maxnumeg);
+ }
+ eglist[numeg] = strdup (indx->egroup);
+ ++numeg;
+ }
}
- }
- return numeg ;
+ return numeg;
}
-int mkeglist(Indiv **indm, int numindivs, char **eglist)
+int
+mkeglist (Indiv **indm, int numindivs, char **eglist)
{
- Indiv *indx ;
- int i, k, numeg=0 ;
- for (i=0; i<numindivs; i++) {
- indx = indm[i] ;
- if (indx -> ignore) continue ;
- k = indxindex(eglist, numeg, indx->egroup) ;
- if (k<0) {
- eglist[numeg] = strdup(indx->egroup) ;
- ++numeg ;
+ Indiv *indx;
+ int i, k, numeg = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indm[i];
+ if (indx->ignore)
+ continue;
+ k = indxindex (eglist, numeg, indx->egroup);
+ if (k < 0)
+ {
+ eglist[numeg] = strdup (indx->egroup);
+ ++numeg;
+ }
}
- }
- return numeg ;
+ return numeg;
}
-int loadlist(char **list, char *listname)
+int
+loadlist (char **list, char *listname)
// listname is just a list of names ...
{
- FILE *lfile ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, n=0 ;
+ FILE *lfile;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, n = 0;
- if (listname == NULL) return 0 ;
- openit(listname, &lfile, "r") ;
- while (fgets(line, MAXSTR, lfile) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- list[n] = strdup(sx) ;
- ++n ;
- freeup(spt, nsplit) ;
- }
- return n ;
+ if (listname == NULL)
+ return 0;
+ openit (listname, &lfile, "r");
+ while (fgets (line, MAXSTR, lfile) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ list[n] = strdup (sx);
+ ++n;
+ freeup (spt, nsplit);
+ }
+ return n;
}
-int loadlist_type(char **list, char *listname, int *ztypes, int off)
+int
+loadlist_type (char **list, char *listname, int *ztypes, int off)
// listname is just a list of names ...
{
- FILE *lfile ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- Indiv *indx ;
- int nsplit, i, n=0, tt ;
+ FILE *lfile;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ Indiv *indx;
+ int nsplit, i, n = 0, tt;
- if (listname == NULL) return 0 ;
- openit(listname, &lfile, "r") ;
- while (fgets(line, MAXSTR, lfile) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit <2) fatalx("bad listname: %s\n", sx) ;
- list[n] = strdup(sx) ;
- tt = atoi(spt[1]) ;
- ztypes[n] = tt + off ;
- ++n ;
- freeup(spt, nsplit) ;
- }
- return n ;
+ if (listname == NULL)
+ return 0;
+ openit (listname, &lfile, "r");
+ while (fgets (line, MAXSTR, lfile) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < 2)
+ fatalx ("bad listname: %s\n", sx);
+ list[n] = strdup (sx);
+ tt = atoi (spt[1]);
+ ztypes[n] = tt + off;
+ ++n;
+ freeup (spt, nsplit);
+ }
+ return n;
}
-
-void seteglist(Indiv **indm, int nindiv, char *eglistname)
+void
+seteglist (Indiv **indm, int nindiv, char *eglistname)
{
- FILE *egfile ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- Indiv *indx ;
- int nsplit, i ;
+ FILE *egfile;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ Indiv *indx;
+ int nsplit, i;
- if (eglistname == NULL) return ;
- openit(eglistname, &egfile, "r") ;
- while (fgets(line, MAXSTR, egfile) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') continue ;
- setstatus(indm, nindiv, sx) ;
- freeup(spt, nsplit) ;
- }
- fclose(egfile) ;
+ if (eglistname == NULL)
+ return;
+ openit (eglistname, &egfile, "r");
+ while (fgets (line, MAXSTR, egfile) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ continue;
+ setstatus (indm, nindiv, sx);
+ freeup (spt, nsplit);
+ }
+ fclose (egfile);
}
-void seteglistv(Indiv **indm, int nindiv, char *eglistname, int val)
+void
+seteglistv (Indiv **indm, int nindiv, char *eglistname, int val)
{
- FILE *egfile ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx = NULL ;
- Indiv *indx ;
- int nsplit, i ;
+ FILE *egfile;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx = NULL;
+ Indiv *indx;
+ int nsplit, i;
- if (eglistname == NULL) {
- setstatusv(indm, nindiv, NULL, val) ;
- }
+ if (eglistname == NULL)
+ {
+ setstatusv (indm, nindiv, NULL, val);
+ }
- openit(eglistname, &egfile, "r") ;
- while (fgets(line, MAXSTR, egfile) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') continue ;
- setstatusv(indm, nindiv, sx, val) ;
- freeup(spt, nsplit) ;
- }
- fclose(egfile) ;
+ openit (eglistname, &egfile, "r");
+ while (fgets (line, MAXSTR, egfile) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ continue;
+ setstatusv (indm, nindiv, sx, val);
+ freeup (spt, nsplit);
+ }
+ fclose (egfile);
}
-
diff --git a/src/eigensrc/LICENSE.txt b/src/eigensrc/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/src/eigensrc/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/src/eigensrc/eigenstrat.c b/src/eigensrc/eigenstrat.c
index 3d7a8a7..ae2df8a 100644
--- a/src/eigensrc/eigenstrat.c
+++ b/src/eigensrc/eigenstrat.c
@@ -8,7 +8,8 @@
int *outlier, noutlier;
int K, L, NSAMPLES, nSNP;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
int k, x, m, n, i, nflags;
double *xx, *iscase;
@@ -22,338 +23,448 @@ int main(int argc, char **argv)
char *PCAFILE = NULL;
char *PHENOFILE = NULL;
- double compute_chisq(double *source, double *target);
- double compute_chisqE(double *source, double *target);
+ double
+ compute_chisq (double *source, double *target);
+ double
+ compute_chisqE (double *source, double *target);
/* set default values */
- L=10;
+ L = 10;
/* process flags */
nflags = 0;
- while((i = getopt(argc,argv,"i:j:p:l:o:")) != -1)
- {
- switch(i)
+ while ((i = getopt (argc, argv, "i:j:p:l:o:")) != -1)
{
- case 'i': /* input genotype file */
- INFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'j': /* input phenotype file */
- PHENOFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'p': /* input phenotype file */
- PCAFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'l':
- L = atoi(optarg); /* number of principal components to correct */
- break;
- case 'o': /* output file */
- OUTFILE = (char *) strdup(optarg);
- nflags++; break;
+ switch (i)
+ {
+ case 'i': /* input genotype file */
+ INFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'j': /* input phenotype file */
+ PHENOFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'p': /* input phenotype file */
+ PCAFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'l':
+ L = atoi (optarg); /* number of principal components to correct */
+ break;
+ case 'o': /* output file */
+ OUTFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ }
}
- }
- if(nflags != 4)
- {
- fprintf(stderr,"Usage: -i -j -p -o flags must all be specified\n");
- exit(1);
- }
+ if (nflags != 4)
+ {
+ fprintf (stderr, "Usage: -i -j -p -o flags must all be specified\n");
+ exit (1);
+ }
/* open output file */
- if( (fpout = fopen(OUTFILE, "w")) == NULL)
- {
- fprintf(stderr,"Could not open output file %s\n", OUTFILE); exit(1);
- }
+ if ((fpout = fopen (OUTFILE, "w")) == NULL)
+ {
+ fprintf (stderr, "Could not open output file %s\n", OUTFILE);
+ exit (1);
+ }
/* print parameters */
- fprintf(fpout,"eigenstrat program run using parameters\n");
- fprintf(fpout," -i %s\n",INFILE);
- fprintf(fpout," -j %s\n",PHENOFILE);
- fprintf(fpout," -p %s\n",PCAFILE);
- fprintf(fpout," -l %d\n",L);
- fprintf(fpout," -o %s\n",OUTFILE);
- fprintf(fpout,"\n");
- fprintf(fpout,"Chisq EIGENSTRAT\n");
+ fprintf (fpout, "eigenstrat program run using parameters\n");
+ fprintf (fpout, " -i %s\n", INFILE);
+ fprintf (fpout, " -j %s\n", PHENOFILE);
+ fprintf (fpout, " -p %s\n", PCAFILE);
+ fprintf (fpout, " -l %d\n", L);
+ fprintf (fpout, " -o %s\n", OUTFILE);
+ fprintf (fpout, "\n");
+ fprintf (fpout, "Chisq EIGENSTRAT\n");
/* Determine NSAMPLES */
- if( (fp = fopen(INFILE, "r")) == NULL)
+ if ((fp = fopen (INFILE, "r")) == NULL)
{
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
}
n = 0;
- while(1)
- {
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '\n') break;
- n++;
- }
+ while (1)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '\n')
+ break;
+ n++;
+ }
NSAMPLES = n;
- fclose(fp);
+ fclose (fp);
/* malloc */
- if((V = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*V))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((outlier = (int *) malloc(NSAMPLES*sizeof(*outlier))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((iscase = (double *) malloc(NSAMPLES*sizeof(*iscase))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((iscasecorr = (double *) malloc(NSAMPLES*sizeof(*iscasecorr))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((xx = (double *) malloc(NSAMPLES*sizeof(*xx))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
+ if ((V = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*V))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((outlier = (int *) malloc (NSAMPLES * sizeof(*outlier))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((iscase = (double *) malloc (NSAMPLES * sizeof(*iscase))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((iscasecorr = (double *) malloc (NSAMPLES * sizeof(*iscasecorr))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((xx = (double *) malloc (NSAMPLES * sizeof(*xx))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
/* FIRST, do PCAFILE */
/* Build V[] and K and outlier[] */
- if( (fppca = fopen(PCAFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", PCAFILE); exit(1);
- }
- fscanf(fppca,"%d",&K);
- if(L > K)
- {
- fprintf(stderr,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- fprintf(fpout,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- exit(1);
- }
- for(x=0; x<K; x++) fscanf(fppca,"%lf",&tempdouble); /* eigenvalues */
- for(n=0; n<NSAMPLES; n++)
- {
- for(k=0; k<K; k++) fscanf(fppca,"%lf",&V[NSAMPLES*n+k]);
- if(feof(fppca))
+ if ((fppca = fopen (PCAFILE, "r")) == NULL)
{
- fprintf(stderr,"OOPS: %s contains less than %d times %d entries\n",PCAFILE,NSAMPLES,K);
- fprintf(fpout,"OOPS: %s contains less than %d times %d entries\n",PCAFILE,NSAMPLES,K);
- exit(1);
+ fprintf (stderr, "Could not open input file %s\n", PCAFILE);
+ exit (1);
}
- /* check for outliers */
- outlier[n] = 1;
- for(k=0; k<K; k++) { if(V[NSAMPLES*n+k] != 0.0) outlier[n] = 0; }
- if(outlier[n] == 1) noutlier++;
- }
- fscanf(fppca,"%lf",&tempdouble);
- if(!(feof(fppca)))
- {
- fprintf(stderr,"OOPS: %s contains too many entries\n",PCAFILE);
- fprintf(fpout,"OOPS: %s contains too many entries\n",PCAFILE);
- exit(1);
- }
-
- /* SECOND, do PHENOFILE */
- /* get phenotypes */
- if( (fppheno = fopen(PHENOFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", PHENOFILE); exit(1);
- }
- for(n=0; n<NSAMPLES; n++)
- {
- fscanf(fppheno,"%c",&Xchar);
- if(Xchar == '0') { iscase[n] = 0.0; }
- else if(Xchar == '1') { iscase[n] = 1.0; }
- else if(Xchar == '9') { iscase[n] = -100.0; }
- else
+ fscanf (fppca, "%d", &K);
+ if (L > K)
{
- fprintf(stderr,"OOPS bad phenotype %c\n",Xchar);
- fprintf(fpout,"OOPS bad phenotype %c\n",Xchar);
- exit(1);
+ fprintf (stderr, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ fprintf (fpout, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ exit (1);
}
- if(feof(fppheno))
+ for (x = 0; x < K; x++)
+ fscanf (fppca, "%lf", &tempdouble); /* eigenvalues */
+ for (n = 0; n < NSAMPLES; n++)
{
- fprintf(stderr,"OOPS: %s contains less than %d entries\n",PHENOFILE,NSAMPLES);
- fprintf(fpout,"OOPS: %s contains less than %d entries\n",PHENOFILE,NSAMPLES);
- exit(1);
+ for (k = 0; k < K; k++)
+ fscanf (fppca, "%lf", &V[NSAMPLES * n + k]);
+ if (feof(fppca))
+ {
+ fprintf (stderr, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ fprintf (fpout, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ exit (1);
+ }
+ /* check for outliers */
+ outlier[n] = 1;
+ for (k = 0; k < K; k++)
+ {
+ if (V[NSAMPLES * n + k] != 0.0)
+ outlier[n] = 0;
+ }
+ if (outlier[n] == 1)
+ noutlier++;
}
- }
- fscanf(fppheno,"%c",&Xchar); /* should be end of file */
- if(((Xchar == '0') || (Xchar == '1') || (Xchar == '9')) && (!(feof(fppheno))))
- {
- fprintf(stderr,"OOPS: %s contains more than %d entries\n",PHENOFILE,NSAMPLES);
- fprintf(fpout,"OOPS: %s contains more than %d entries\n",PHENOFILE,NSAMPLES);
- exit(1);
- }
- /* mean-adjust iscase */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n] == 1) || (iscase[n] == -100.0)) continue;
- rowsum += iscase[n];
- rowsum1 += 1.0;
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(iscase[n] == -100.0) iscase[n] = -100.0; /* still keep track */
- else iscase[n] -= rowsum/rowsum1;
- }
- /* make iscasecorr */
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n] == 0) iscasecorr[n] = iscase[n];
- }
- for(k=0; k<L; k++)
- {
- gamma = 0.0;
- denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ fscanf (fppca, "%lf", &tempdouble);
+ if (!(feof(fppca)))
{
- if((outlier[n]) || (iscase[n] < -99.0)) continue;
- gamma += iscasecorr[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
+ fprintf (stderr, "OOPS: %s contains too many entries\n", PCAFILE);
+ fprintf (fpout, "OOPS: %s contains too many entries\n", PCAFILE);
+ exit (1);
}
- gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
+
+ /* SECOND, do PHENOFILE */
+ /* get phenotypes */
+ if ((fppheno = fopen (PHENOFILE, "r")) == NULL)
{
- if((outlier[n]) || (iscase[n] < -99.0)) continue;
- iscasecorr[n] -= gamma*V[NSAMPLES*n+k];
+ fprintf (stderr, "Could not open input file %s\n", PHENOFILE);
+ exit (1);
}
- }
-
- /* THIRD, do INFILE */
- if( (fp = fopen(INFILE, "r")) == NULL)
+ for (n = 0; n < NSAMPLES; n++)
{
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
+ fscanf (fppheno, "%c", &Xchar);
+ if (Xchar == '0')
+ {
+ iscase[n] = 0.0;
+ }
+ else if (Xchar == '1')
+ {
+ iscase[n] = 1.0;
+ }
+ else if (Xchar == '9')
+ {
+ iscase[n] = -100.0;
+ }
+ else
+ {
+ fprintf (stderr, "OOPS bad phenotype %c\n", Xchar);
+ fprintf (fpout, "OOPS bad phenotype %c\n", Xchar);
+ exit (1);
+ }
+ if (feof(fppheno))
+ {
+ fprintf (stderr, "OOPS: %s contains less than %d entries\n",
+ PHENOFILE, NSAMPLES);
+ fprintf (fpout, "OOPS: %s contains less than %d entries\n", PHENOFILE,
+ NSAMPLES);
+ exit (1);
+ }
}
- m = 0;
- while(1) /* do EVERYTHING for SNP m */
- {
- for(n=0; n<NSAMPLES; n++)
+ fscanf (fppheno, "%c", &Xchar); /* should be end of file */
+ if (((Xchar == '0') || (Xchar == '1') || (Xchar == '9'))
+ && (!(feof(fppheno))))
{
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '0') { xx[n] = 0.0; }
- else if(Xchar == '1') { xx[n] = 0.5; }
- else if(Xchar == '2') { xx[n] = 1.0; }
- else if(Xchar == '9') { xx[n] = -100.0; }
- else if(!(feof(fp)))
- {
- fprintf(stderr,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- fprintf(fpout,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- exit(1);
- }
- if(outlier[n] == 1) xx[n] = -100.0;
+ fprintf (stderr, "OOPS: %s contains more than %d entries\n", PHENOFILE,
+ NSAMPLES);
+ fprintf (fpout, "OOPS: %s contains more than %d entries\n", PHENOFILE,
+ NSAMPLES);
+ exit (1);
}
- if(feof(fp)) break;
- fscanf(fp,"%c",&Xchar); /* should be \n character */
-
- /* mean-adjust xx */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ /* mean-adjust iscase */
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
{
- if((outlier[n]) || (xx[n] < -99.0)) continue;
- rowsum += xx[n];
+ if ((outlier[n] == 1) || (iscase[n] == -100.0))
+ continue;
+ rowsum += iscase[n];
rowsum1 += 1.0;
}
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(xx[n] < -99.0) xx[n] = -100.0; /* still keep track */
- else xx[n] -= rowsum/rowsum1;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (iscase[n] == -100.0)
+ iscase[n] = -100.0; /* still keep track */
+ else
+ iscase[n] -= rowsum / rowsum1;
+ }
+ /* make iscasecorr */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n] == 0)
+ iscasecorr[n] = iscase[n];
}
-
- /* Chisq */
- chisq = compute_chisq(xx,iscase);
-
- /* EIGENSTRAT */
- for(k=0; k<L; k++)
+ for (k = 0; k < L; k++)
{
gamma = 0.0;
denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n]) || (xx[n] < -99.0)) continue;
- gamma += xx[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
- }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (iscase[n] < -99.0))
+ continue;
+ gamma += iscasecorr[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n]) || (xx[n] < -99.0)) continue;
- xx[n] -= gamma*V[NSAMPLES*n+k];
- }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (iscase[n] < -99.0))
+ continue;
+ iscasecorr[n] -= gamma * V[NSAMPLES * n + k];
+ }
}
- Echisq = compute_chisqE(xx,iscasecorr);
- if(rowsum1 == 0.0)
+ /* THIRD, do INFILE */
+ if ((fp = fopen (INFILE, "r")) == NULL)
{
- chisq = -1.0; Echisq = -1.0;
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
}
+ m = 0;
+ while (1) /* do EVERYTHING for SNP m */
+ {
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '0')
+ {
+ xx[n] = 0.0;
+ }
+ else if (Xchar == '1')
+ {
+ xx[n] = 0.5;
+ }
+ else if (Xchar == '2')
+ {
+ xx[n] = 1.0;
+ }
+ else if (Xchar == '9')
+ {
+ xx[n] = -100.0;
+ }
+ else if (!(feof(fp)))
+ {
+ fprintf (stderr, "OOPS bad char %c at m=%d n=%d\n", Xchar, m, n);
+ fprintf (fpout, "OOPS bad char %c at m=%d n=%d\n", Xchar, m, n);
+ exit (1);
+ }
+ if (outlier[n] == 1)
+ xx[n] = -100.0;
+ }
+ if (feof(fp))
+ break;
+ fscanf (fp, "%c", &Xchar); /* should be \n character */
- if(chisq >= 0.0) fprintf(fpout,"%.04f",chisq);
- else fprintf(fpout,"NA");
- if(Echisq >= 0.0) fprintf(fpout," %.04f\n",Echisq);
- else fprintf(fpout," NA\n");
+ /* mean-adjust xx */
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] < -99.0))
+ continue;
+ rowsum += xx[n];
+ rowsum1 += 1.0;
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (xx[n] < -99.0)
+ xx[n] = -100.0; /* still keep track */
+ else
+ xx[n] -= rowsum / rowsum1;
+ }
- m++;
- if(NSAMPLES*m > MAXSIZE)
- {
- fprintf(stderr,"OOPS genotype file has > %d genotypes\n",MAXSIZE);
- fprintf(fpout,"OOPS genotype file has > %d genotypes\n",MAXSIZE);
- exit(1);
+ /* Chisq */
+ chisq = compute_chisq (xx, iscase);
+
+ /* EIGENSTRAT */
+ for (k = 0; k < L; k++)
+ {
+ gamma = 0.0;
+ denom = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] < -99.0))
+ continue;
+ gamma += xx[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
+ gamma /= denom;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] < -99.0))
+ continue;
+ xx[n] -= gamma * V[NSAMPLES * n + k];
+ }
+ }
+ Echisq = compute_chisqE (xx, iscasecorr);
+
+ if (rowsum1 == 0.0)
+ {
+ chisq = -1.0;
+ Echisq = -1.0;
+ }
+
+ if (chisq >= 0.0)
+ fprintf (fpout, "%.04f", chisq);
+ else
+ fprintf (fpout, "NA");
+ if (Echisq >= 0.0)
+ fprintf (fpout, " %.04f\n", Echisq);
+ else
+ fprintf (fpout, " NA\n");
+
+ m++;
+ if (NSAMPLES * m > MAXSIZE)
+ {
+ fprintf (stderr, "OOPS genotype file has > %d genotypes\n", MAXSIZE);
+ fprintf (fpout, "OOPS genotype file has > %d genotypes\n", MAXSIZE);
+ exit (1);
+ }
}
- }
- fclose(fp);
+ fclose (fp);
return 0;
}
-double compute_chisq(double *source, double *target)
+double
+compute_chisq (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(source[n] < -99.0) continue;
- if(target[n] < -99.0) continue;
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (source[n] < -99.0)
+ continue;
+ if (target[n] < -99.0)
+ continue;
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
- corr = (numer/sqrt(denom1*denom2));
- return (sum1*corr*corr);
+ corr = (numer / sqrt (denom1 * denom2));
+ return (sum1 * corr * corr);
}
-double compute_chisqE(double *source, double *target)
+double
+compute_chisqE (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(source[n] < -99.0) continue;
- if(target[n] < -99.0) continue;
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (source[n] < -99.0)
+ continue;
+ if (target[n] < -99.0)
+ continue;
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
- corr = (numer/sqrt(denom1*denom2));
- sum1 = sum1 - ((double)(L+1));
- return (sum1*corr*corr);
+ corr = (numer / sqrt (denom1 * denom2));
+ sum1 = sum1 - ((double) (L + 1));
+ return (sum1 * corr * corr);
}
diff --git a/src/eigensrc/eigenstratQTL.c b/src/eigensrc/eigenstratQTL.c
index f42670b..12cf854 100644
--- a/src/eigensrc/eigenstratQTL.c
+++ b/src/eigensrc/eigenstratQTL.c
@@ -8,7 +8,8 @@
int *outlier, noutlier;
int K, L, NSAMPLES, nSNP;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
int k, x, m, n, i, nflags;
double *xx, *iscase;
@@ -22,329 +23,427 @@ int main(int argc, char **argv)
char *PCAFILE = NULL;
char *PHENOFILE = NULL;
- double compute_chisq(double *source, double *target);
- double compute_chisqE(double *source, double *target);
+ double
+ compute_chisq (double *source, double *target);
+ double
+ compute_chisqE (double *source, double *target);
/* set default values */
- L=10;
+ L = 10;
/* process flags */
nflags = 0;
- while((i = getopt(argc,argv,"i:j:p:l:o:")) != -1)
- {
- switch(i)
+ while ((i = getopt (argc, argv, "i:j:p:l:o:")) != -1)
{
- case 'i': /* input genotype file */
- INFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'j': /* input phenotype file */
- PHENOFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'p': /* input phenotype file */
- PCAFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'l':
- L = atoi(optarg); /* number of principal components to correct */
- break;
- case 'o': /* output file */
- OUTFILE = (char *) strdup(optarg);
- nflags++; break;
+ switch (i)
+ {
+ case 'i': /* input genotype file */
+ INFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'j': /* input phenotype file */
+ PHENOFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'p': /* input phenotype file */
+ PCAFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'l':
+ L = atoi (optarg); /* number of principal components to correct */
+ break;
+ case 'o': /* output file */
+ OUTFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ }
}
- }
- if(nflags != 4)
- {
- fprintf(stderr,"Usage: -i -j -p -o flags must all be specified\n");
- exit(1);
- }
+ if (nflags != 4)
+ {
+ fprintf (stderr, "Usage: -i -j -p -o flags must all be specified\n");
+ exit (1);
+ }
/* open output file */
- if( (fpout = fopen(OUTFILE, "w")) == NULL)
- {
- fprintf(stderr,"Could not open output file %s\n", OUTFILE); exit(1);
- }
+ if ((fpout = fopen (OUTFILE, "w")) == NULL)
+ {
+ fprintf (stderr, "Could not open output file %s\n", OUTFILE);
+ exit (1);
+ }
/* print parameters */
- fprintf(fpout,"eigenstratQTL program run using parameters\n");
- fprintf(fpout," -i %s\n",INFILE);
- fprintf(fpout," -j %s\n",PHENOFILE);
- fprintf(fpout," -p %s\n",PCAFILE);
- fprintf(fpout," -l %d\n",L);
- fprintf(fpout," -o %s\n",OUTFILE);
- fprintf(fpout,"\n");
- fprintf(fpout,"Chisq EIGENSTRAT\n");
+ fprintf (fpout, "eigenstratQTL program run using parameters\n");
+ fprintf (fpout, " -i %s\n", INFILE);
+ fprintf (fpout, " -j %s\n", PHENOFILE);
+ fprintf (fpout, " -p %s\n", PCAFILE);
+ fprintf (fpout, " -l %d\n", L);
+ fprintf (fpout, " -o %s\n", OUTFILE);
+ fprintf (fpout, "\n");
+ fprintf (fpout, "Chisq EIGENSTRAT\n");
/* Determine NSAMPLES */
- if( (fp = fopen(INFILE, "r")) == NULL)
+ if ((fp = fopen (INFILE, "r")) == NULL)
{
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
}
n = 0;
- while(1)
- {
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '\n') break;
- n++;
- }
+ while (1)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '\n')
+ break;
+ n++;
+ }
NSAMPLES = n;
- fclose(fp);
+ fclose (fp);
/* malloc */
- if((V = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*V))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((outlier = (int *) malloc(NSAMPLES*sizeof(*outlier))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((iscase = (double *) malloc(NSAMPLES*sizeof(*iscase))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((iscasecorr = (double *) malloc(NSAMPLES*sizeof(*iscasecorr))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((xx = (double *) malloc(NSAMPLES*sizeof(*xx))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
+ if ((V = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*V))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((outlier = (int *) malloc (NSAMPLES * sizeof(*outlier))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((iscase = (double *) malloc (NSAMPLES * sizeof(*iscase))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((iscasecorr = (double *) malloc (NSAMPLES * sizeof(*iscasecorr))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((xx = (double *) malloc (NSAMPLES * sizeof(*xx))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
/* FIRST, do PCAFILE */
/* Build V[] and K and outlier[] */
- if( (fppca = fopen(PCAFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", PCAFILE); exit(1);
- }
- fscanf(fppca,"%d",&K);
- if(L > K)
- {
- fprintf(stderr,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- fprintf(fpout,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- exit(1);
- }
- for(x=0; x<K; x++) fscanf(fppca,"%lf",&tempdouble); /* eigenvalues */
- for(n=0; n<NSAMPLES; n++)
- {
- for(k=0; k<K; k++) fscanf(fppca,"%lf",&V[NSAMPLES*n+k]);
- if(feof(fppca))
+ if ((fppca = fopen (PCAFILE, "r")) == NULL)
{
- fprintf(stderr,"OOPS: %s contains less than %d times %d entries\n",PCAFILE,NSAMPLES,K);
- fprintf(fpout,"OOPS: %s contains less than %d times %d entries\n",PCAFILE,NSAMPLES,K);
- exit(1);
+ fprintf (stderr, "Could not open input file %s\n", PCAFILE);
+ exit (1);
}
- /* check for outliers */
- outlier[n] = 1;
- for(k=0; k<K; k++) { if(V[NSAMPLES*n+k] != 0.0) outlier[n] = 0; }
- if(outlier[n] == 1) noutlier++;
- }
- fscanf(fppca,"%lf",&tempdouble);
- if(!(feof(fppca)))
- {
- fprintf(stderr,"OOPS: %s contains too many entries\n",PCAFILE);
- fprintf(fpout,"OOPS: %s contains too many entries\n",PCAFILE);
- exit(1);
- }
-
- /* SECOND, do PHENOFILE */
- /* get phenotypes */
- if( (fppheno = fopen(PHENOFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", PHENOFILE); exit(1);
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(feof(fppheno))
+ fscanf (fppca, "%d", &K);
+ if (L > K)
{
- fprintf(stderr,"OOPS: %s contains less than %d entries\n",PHENOFILE,NSAMPLES);
- fprintf(fpout,"OOPS: %s contains less than %d entries\n",PHENOFILE,NSAMPLES);
- exit(1);
+ fprintf (stderr, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ fprintf (fpout, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ exit (1);
}
- fscanf(fppheno,"%lf",&iscase[n]); /* QTL phenotype */
- }
- fscanf(fppheno,"%lf",&tempdouble); /* to check # entries */
- if(!(feof(fppheno)))
- {
- fprintf(stderr,"OOPS: %s contains too many entries\n",PHENOFILE);
- fprintf(fpout,"OOPS: %s contains too many entries\n",PHENOFILE);
- exit(1);
- }
- /* mean-adjust iscase */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n] == 1) || (iscase[n] == -100.0)) continue;
- rowsum += iscase[n];
- rowsum1 += 1.0;
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(iscase[n] == -100.0) iscase[n] = -100.0; /* still keep track */
- else iscase[n] -= rowsum/rowsum1;
- }
- /* make iscasecorr */
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n] == 0) iscasecorr[n] = iscase[n];
- }
- for(k=0; k<L; k++)
- {
- gamma = 0.0;
- denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ for (x = 0; x < K; x++)
+ fscanf (fppca, "%lf", &tempdouble); /* eigenvalues */
+ for (n = 0; n < NSAMPLES; n++)
{
- if((outlier[n]) || (iscase[n] == -100.0)) continue;
- gamma += iscasecorr[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
+ for (k = 0; k < K; k++)
+ fscanf (fppca, "%lf", &V[NSAMPLES * n + k]);
+ if (feof(fppca))
+ {
+ fprintf (stderr, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ fprintf (fpout, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ exit (1);
+ }
+ /* check for outliers */
+ outlier[n] = 1;
+ for (k = 0; k < K; k++)
+ {
+ if (V[NSAMPLES * n + k] != 0.0)
+ outlier[n] = 0;
+ }
+ if (outlier[n] == 1)
+ noutlier++;
}
- gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
+ fscanf (fppca, "%lf", &tempdouble);
+ if (!(feof(fppca)))
{
- if((outlier[n]) || (iscase[n] == -100.0)) continue;
- iscasecorr[n] -= gamma*V[NSAMPLES*n+k];
+ fprintf (stderr, "OOPS: %s contains too many entries\n", PCAFILE);
+ fprintf (fpout, "OOPS: %s contains too many entries\n", PCAFILE);
+ exit (1);
}
- }
- /* THIRD, do INFILE */
- if( (fp = fopen(INFILE, "r")) == NULL)
+ /* SECOND, do PHENOFILE */
+ /* get phenotypes */
+ if ((fppheno = fopen (PHENOFILE, "r")) == NULL)
{
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
+ fprintf (stderr, "Could not open input file %s\n", PHENOFILE);
+ exit (1);
}
- m = 0;
- while(1) /* do EVERYTHING for SNP m */
- {
- for(n=0; n<NSAMPLES; n++)
+ for (n = 0; n < NSAMPLES; n++)
{
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '0') { xx[n] = 0.0; }
- else if(Xchar == '1') { xx[n] = 0.5; }
- else if(Xchar == '2') { xx[n] = 1.0; }
- else if(Xchar == '9') { xx[n] = -100.0; }
- else if(!(feof(fp)))
- {
- fprintf(stderr,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- fprintf(fpout,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- exit(1);
- }
- if(outlier[n] == 1) xx[n] = -100.0;
+ if (feof(fppheno))
+ {
+ fprintf (stderr, "OOPS: %s contains less than %d entries\n",
+ PHENOFILE, NSAMPLES);
+ fprintf (fpout, "OOPS: %s contains less than %d entries\n", PHENOFILE,
+ NSAMPLES);
+ exit (1);
+ }
+ fscanf (fppheno, "%lf", &iscase[n]); /* QTL phenotype */
}
- if(feof(fp)) break;
- fscanf(fp,"%c",&Xchar); /* should be \n character */
-
- /* mean-adjust xx */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ fscanf (fppheno, "%lf", &tempdouble); /* to check # entries */
+ if (!(feof(fppheno)))
+ {
+ fprintf (stderr, "OOPS: %s contains too many entries\n", PHENOFILE);
+ fprintf (fpout, "OOPS: %s contains too many entries\n", PHENOFILE);
+ exit (1);
+ }
+ /* mean-adjust iscase */
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
{
- if((outlier[n]) || (xx[n] == -100.0)) continue;
- rowsum += xx[n];
+ if ((outlier[n] == 1) || (iscase[n] == -100.0))
+ continue;
+ rowsum += iscase[n];
rowsum1 += 1.0;
}
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(xx[n] == -100.0) xx[n] = -100.0; /* still keep track */
- else xx[n] -= rowsum/rowsum1;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (iscase[n] == -100.0)
+ iscase[n] = -100.0; /* still keep track */
+ else
+ iscase[n] -= rowsum / rowsum1;
+ }
+ /* make iscasecorr */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n] == 0)
+ iscasecorr[n] = iscase[n];
}
-
- /* Chisq */
- chisq = compute_chisq(xx,iscase);
-
- /* EIGENSTRAT */
- for(k=0; k<L; k++)
+ for (k = 0; k < L; k++)
{
gamma = 0.0;
denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n]) || (xx[n] == -100.0)) continue;
- gamma += xx[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
- }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (iscase[n] == -100.0))
+ continue;
+ gamma += iscasecorr[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n]) || (xx[n] == -100.0)) continue;
- xx[n] -= gamma*V[NSAMPLES*n+k];
- }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (iscase[n] == -100.0))
+ continue;
+ iscasecorr[n] -= gamma * V[NSAMPLES * n + k];
+ }
}
- Echisq = compute_chisqE(xx,iscasecorr);
- if(rowsum1 == 0.0)
+ /* THIRD, do INFILE */
+ if ((fp = fopen (INFILE, "r")) == NULL)
{
- chisq = -1.0; Echisq = -1.0;
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
}
+ m = 0;
+ while (1) /* do EVERYTHING for SNP m */
+ {
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '0')
+ {
+ xx[n] = 0.0;
+ }
+ else if (Xchar == '1')
+ {
+ xx[n] = 0.5;
+ }
+ else if (Xchar == '2')
+ {
+ xx[n] = 1.0;
+ }
+ else if (Xchar == '9')
+ {
+ xx[n] = -100.0;
+ }
+ else if (!(feof(fp)))
+ {
+ fprintf (stderr, "OOPS bad char %c at m=%d n=%d\n", Xchar, m, n);
+ fprintf (fpout, "OOPS bad char %c at m=%d n=%d\n", Xchar, m, n);
+ exit (1);
+ }
+ if (outlier[n] == 1)
+ xx[n] = -100.0;
+ }
+ if (feof(fp))
+ break;
+ fscanf (fp, "%c", &Xchar); /* should be \n character */
- if(chisq >= 0.0) fprintf(fpout,"%.04f",chisq);
- else fprintf(fpout,"NA");
- if(Echisq >= 0.0) fprintf(fpout," %.04f\n",Echisq);
- else fprintf(fpout," NA\n");
+ /* mean-adjust xx */
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] == -100.0))
+ continue;
+ rowsum += xx[n];
+ rowsum1 += 1.0;
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (xx[n] == -100.0)
+ xx[n] = -100.0; /* still keep track */
+ else
+ xx[n] -= rowsum / rowsum1;
+ }
- m++;
- if(NSAMPLES*m > MAXSIZE)
- {
- fprintf(stderr,"OOPS genotype file has > %d genotypes\n",MAXSIZE);
- fprintf(fpout,"OOPS genotype file has > %d genotypes\n",MAXSIZE);
- exit(1);
+ /* Chisq */
+ chisq = compute_chisq (xx, iscase);
+
+ /* EIGENSTRAT */
+ for (k = 0; k < L; k++)
+ {
+ gamma = 0.0;
+ denom = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] == -100.0))
+ continue;
+ gamma += xx[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
+ gamma /= denom;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n]) || (xx[n] == -100.0))
+ continue;
+ xx[n] -= gamma * V[NSAMPLES * n + k];
+ }
+ }
+ Echisq = compute_chisqE (xx, iscasecorr);
+
+ if (rowsum1 == 0.0)
+ {
+ chisq = -1.0;
+ Echisq = -1.0;
+ }
+
+ if (chisq >= 0.0)
+ fprintf (fpout, "%.04f", chisq);
+ else
+ fprintf (fpout, "NA");
+ if (Echisq >= 0.0)
+ fprintf (fpout, " %.04f\n", Echisq);
+ else
+ fprintf (fpout, " NA\n");
+
+ m++;
+ if (NSAMPLES * m > MAXSIZE)
+ {
+ fprintf (stderr, "OOPS genotype file has > %d genotypes\n", MAXSIZE);
+ fprintf (fpout, "OOPS genotype file has > %d genotypes\n", MAXSIZE);
+ exit (1);
+ }
}
- }
- fclose(fp);
+ fclose (fp);
return 0;
}
-double compute_chisq(double *source, double *target)
+double
+compute_chisq (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(source[n] == -100.0) continue;
- if(target[n] == -100.0) continue;
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (source[n] == -100.0)
+ continue;
+ if (target[n] == -100.0)
+ continue;
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
- corr = (numer/sqrt(denom1*denom2));
- return (sum1*corr*corr);
+ corr = (numer / sqrt (denom1 * denom2));
+ return (sum1 * corr * corr);
}
-double compute_chisqE(double *source, double *target)
+double
+compute_chisqE (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(source[n] == -100.0) continue;
- if(target[n] == -100.0) continue;
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (source[n] == -100.0)
+ continue;
+ if (target[n] == -100.0)
+ continue;
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
- corr = (numer/sqrt(denom1*denom2));
- sum1 = sum1 - ((double)(L+1));
- return (sum1*corr*corr);
+ corr = (numer / sqrt (denom1 * denom2));
+ sum1 = sum1 - ((double) (L + 1));
+ return (sum1 * corr * corr);
}
diff --git a/src/eigensrc/eigsubs.c b/src/eigensrc/eigsubs.c
index 55d83b6..f611f94 100644
--- a/src/eigensrc/eigsubs.c
+++ b/src/eigensrc/eigsubs.c
@@ -5,219 +5,249 @@
#include <vsubs.h>
#include <eigsubs.h>
-
/* ********************************************************************* */
-void eigx_(double *pmat, double *ev, int *n) ;
-void eigxv_(double *pmat, double *eval, double *evec, int *n) ;
-void cdc_(double *pmat, int *n) ;
-void inverse_(double *pmat, int *n);
-void solve_(double *pmat, double *v, int *n) ;
-void geneigsolve_(double *pmat, double *qmat, double *eval, int *n);
-
-void packsym(double *pmat, double *mat, int n) ;
+void
+eigx_ (double *pmat, double *ev, int *n);
+void
+eigxv_ (double *pmat, double *eval, double *evec, int *n);
+void
+cdc_ (double *pmat, int *n);
+void
+inverse_ (double *pmat, int *n);
+void
+solve_ (double *pmat, double *v, int *n);
+void
+geneigsolve_ (double *pmat, double *qmat, double *eval, int *n);
+void
+packsym (double *pmat, double *mat, int n);
-void eigvals(double *mat, double *evals, int n)
+void
+eigvals (double *mat, double *evals, int n)
{
- double *pmat ;
- int len ;
-
- len = n*(n+1) ; len /= 2 ;
- ZALLOC(pmat, len, double) ;
-
- vst(mat, mat, -1.0, n*n) ;
- packsym(pmat, mat, n) ;
- eigx_(pmat, evals, &n) ;
- free(pmat) ;
- vst(mat, mat, -1.0, n*n) ;
- vst(evals, evals, -1.0, n) ;
+ double *pmat;
+ int len;
+
+ len = n * (n + 1);
+ len /= 2;
+ ZALLOC(pmat, len, double);
+
+ vst (mat, mat, -1.0, n * n);
+ packsym (pmat, mat, n);
+ eigx_ (pmat, evals, &n);
+ free (pmat);
+ vst (mat, mat, -1.0, n * n);
+ vst (evals, evals, -1.0, n);
}
-void eigvecs(double *mat, double *evals, double *evecs, int n)
+void
+eigvecs (double *mat, double *evals, double *evecs, int n)
{
- double *pmat ;
- int len ;
+ double *pmat;
+ int len;
- len = n*(n+1) ; len /= 2 ;
- ZALLOC(pmat, len, double) ;
+ len = n * (n + 1);
+ len /= 2;
+ ZALLOC(pmat, len, double);
- vst(mat, mat, -1.0, n*n) ;
- packsym(pmat, mat, n) ;
+ vst (mat, mat, -1.0, n * n);
+ packsym (pmat, mat, n);
- eigxv_(pmat, evals, evecs, &n) ;
- free(pmat) ;
- vst(mat, mat, -1.0, n*n) ;
- vst(evals, evals, -1.0, n) ;
+ eigxv_ (pmat, evals, evecs, &n);
+ free (pmat);
+ vst (mat, mat, -1.0, n * n);
+ vst (evals, evals, -1.0, n);
}
/* note: dpotrf requires the entire matrix, not packed lower-tri */
-void chdecomp(double *mat, int n)
+void
+chdecomp (double *mat, int n)
{
- /* symetric matrix - don't need to
- * convert to column major order */
+ /* symetric matrix - don't need to
+ * convert to column major order */
- cdc_(mat, &n);
+ cdc_ (mat, &n);
}
-void inverse(double *mat, int n)
+void
+inverse (double *mat, int n)
{
- int i,j;
+ int i, j;
- /* convert to column-major order */
- for(i=0;i<n;i++) {
- for(j=0;j<i;j++) {
- double t = mat[n*i+j];
- mat[n*i+j] = mat[n*j+i];
- mat[n*j+i] = t;
- }
- }
+ /* convert to column-major order */
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < i; j++)
+ {
+ double t = mat[n * i + j];
+ mat[n * i + j] = mat[n * j + i];
+ mat[n * j + i] = t;
+ }
+ }
/*** DEBUGGING: ***/
- {
- FILE *fid = fopen("eigsubs.dbg","a");
- fprintf(fid,"matrix U\n");
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- fprintf(fid,"%8.4f ", mat[i*n+j]);
- }
- fprintf(fid, "\n");
+ {
+ FILE *fid = fopen ("eigsubs.dbg", "a");
+ fprintf (fid, "matrix U\n");
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fid, "%8.4f ", mat[i * n + j]);
+ }
+ fprintf (fid, "\n");
+ }
}
- }
/*******************/
- inverse_(mat, &n);
+ inverse_ (mat, &n);
/*** DEBUGGING: ***/
- {
- FILE *fid = fopen("eigsubs.dbg","a");
- fprintf(fid,"inverse of matrix U\n");
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- fprintf(fid,"%8.4f ", mat[i*n+j]);
- }
- fprintf(fid, "\n");
+ {
+ FILE *fid = fopen ("eigsubs.dbg", "a");
+ fprintf (fid, "inverse of matrix U\n");
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fid, "%8.4f ", mat[i * n + j]);
+ }
+ fprintf (fid, "\n");
+ }
}
- }
/*******************/
- for(i=0;i<n;i++) {
- for(j=0;j<i;j++) {
- double t = mat[n*i+j];
- mat[n*i+j] = mat[n*j+i];
- mat[n*j+i] = t;
- }
- }
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < i; j++)
+ {
+ double t = mat[n * i + j];
+ mat[n * i + j] = mat[n * j + i];
+ mat[n * j + i] = t;
+ }
+ }
}
-void solve(double *mat, double *b, double *v, int n)
+void
+solve (double *mat, double *b, double *v, int n)
{
- int i,j;
+ int i, j;
- double *mat2 = (double *)malloc(n*n*sizeof(double));
+ double *mat2 = (double *) malloc (n * n * sizeof(double));
- /* lapack is going to put the lu-decomp into the matrix,
- * so make a copy and convert to column-major order */
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- mat2[n*i+j] = mat[n*j+i];
- }
- }
+ /* lapack is going to put the lu-decomp into the matrix,
+ * so make a copy and convert to column-major order */
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ mat2[n * i + j] = mat[n * j + i];
+ }
+ }
- /* copy b into v */
- for(i=0;i<n;i++) {
- v[i] = b[i];
- }
+ /* copy b into v */
+ for (i = 0; i < n; i++)
+ {
+ v[i] = b[i];
+ }
- solve_(mat2, v, &n);
+ solve_ (mat2, v, &n);
- free(mat2);
- return;
+ free (mat2);
+ return;
}
-
+
void
-packsym(double *pmat, double *mat, int n)
- // lapack L mode (fortran)
-{
- int i, j, k = 0 ;
- for (i=0; i<n; i++) {
- for (j=i; j<n; j++) {
- pmat[k] = mat[i*n+j] ;
- ++k ;
- }
- }
+packsym (double *pmat, double *mat, int n)
+// lapack L mode (fortran)
+{
+ int i, j, k = 0;
+ for (i = 0; i < n; i++)
+ {
+ for (j = i; j < n; j++)
+ {
+ pmat[k] = mat[i * n + j];
+ ++k;
+ }
+ }
}
-void geneigsolve(double *pmat, double *qmat, double *evec, double *eval, int n) {
+void
+geneigsolve (double *pmat, double *qmat, double *evec, double *eval, int n)
+{
/* save copy of A and B, which LAPACK will overwrite */
- double *amat = (double *)malloc(n*n*sizeof(double));
- double *bmat = (double *)malloc(n*n*sizeof(double));
+ double *amat = (double *) malloc (n * n * sizeof(double));
+ double *bmat = (double *) malloc (n * n * sizeof(double));
int i, j;
- for(i=0;i<n*n;i++) {
- amat[i] = pmat[i];
- bmat[i] = qmat[i];
- }
-
-
-
-
- {
- FILE *fid = fopen("eigsubs.dbg","a");
- fprintf(fid,"matrix A\n");
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- fprintf(fid,"%8.4f ", amat[i*n+j]);
- }
- fprintf(fid, "\n");
+ for (i = 0; i < n * n; i++)
+ {
+ amat[i] = pmat[i];
+ bmat[i] = qmat[i];
}
- fprintf(fid,"matrix B\n");
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- fprintf(fid,"%8.4f ", bmat[i*n+j]);
- }
- fprintf(fid, "\n");
+ {
+ FILE *fid = fopen ("eigsubs.dbg", "a");
+ fprintf (fid, "matrix A\n");
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fid, "%8.4f ", amat[i * n + j]);
+ }
+ fprintf (fid, "\n");
+ }
+
+ fprintf (fid, "matrix B\n");
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fid, "%8.4f ", bmat[i * n + j]);
+ }
+ fprintf (fid, "\n");
+ }
+ fclose (fid);
}
- fclose(fid);
- }
-
/* matrices have to be symetric-definite, so don't
* need to convert to column-major order */
- geneigsolve_(pmat, qmat, eval, &n);
+ geneigsolve_ (pmat, qmat, eval, &n);
-
- /* copy eigenvectors to A and original A,B back */
+ /* copy eigenvectors to A and original A,B back */
/* ith eigenvector should be in row i */
- for(i=0;i<n;i++) {
- for(j=0;j<n;j++) {
- evec[i*n+j] = pmat[i*n+j]; /* don't put back in row-major order (?) */
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ evec[i * n + j] = pmat[i * n + j]; /* don't put back in row-major order (?) */
+ }
+ }
+ for (i = 0; i < n * n; i++)
+ {
+ pmat[i] = amat[i];
+ qmat[i] = bmat[i];
}
- }
- for(i=0;i<n*n;i++) {
- pmat[i] = amat[i];
- qmat[i] = bmat[i];
- }
/* LAPACK puts evals and evecs in ascending order */
/* reorder evals and evecs so evals are in descending order */
- for(i=0;i<n/2;i++) {
- double t = eval[i];
- eval[i] = eval[n-1-i];
- eval[n-1-i] = t;
-
- for(j=0;j<n;j++) { /* exchange row i and row(n-1-i) */
- t = evec[i*n+j];
- evec[i*n+j] = evec[(n-1-i)*n+j];
- evec[(n-1-i)*n+j] = t;
+ for (i = 0; i < n / 2; i++)
+ {
+ double t = eval[i];
+ eval[i] = eval[n - 1 - i];
+ eval[n - 1 - i] = t;
+
+ for (j = 0; j < n; j++)
+ { /* exchange row i and row(n-1-i) */
+ t = evec[i * n + j];
+ evec[i * n + j] = evec[(n - 1 - i) * n + j];
+ evec[(n - 1 - i) * n + j] = t;
+ }
}
- }
- free(amat);
- free(bmat);
+ free (amat);
+ free (bmat);
}
-
-
diff --git a/src/eigensrc/eigx.c b/src/eigensrc/eigx.c
index 9f91285..070e322 100644
--- a/src/eigensrc/eigx.c
+++ b/src/eigensrc/eigx.c
@@ -24,186 +24,229 @@ typedef long int __CLPK_integer;
#endif
typedef double __CLPK_doublereal;
-int dspev_(char* jobz, char* uplo, __CLPK_integer* n, __CLPK_doublereal* ap,
- __CLPK_doublereal* w, __CLPK_doublereal* z__, __CLPK_integer* ldz,
- __CLPK_doublereal* work, __CLPK_integer* info);
+int
+dspev_ (char* jobz, char* uplo, __CLPK_integer* n, __CLPK_doublereal* ap,
+__CLPK_doublereal* w, __CLPK_doublereal* z__, __CLPK_integer* ldz,
+__CLPK_doublereal* work, __CLPK_integer* info);
-int dpotrf_(char* uplo, __CLPK_integer* n, __CLPK_doublereal* a,
- __CLPK_integer* lda, __CLPK_integer* info);
+int
+dpotrf_ (char* uplo, __CLPK_integer* n, __CLPK_doublereal* a,
+__CLPK_integer* lda, __CLPK_integer* info);
-int dgetrf_(__CLPK_integer* m, __CLPK_integer* n, __CLPK_doublereal* a,
- __CLPK_integer* lda, __CLPK_integer* ipiv, __CLPK_integer* info);
+int
+dgetrf_ (__CLPK_integer* m, __CLPK_integer* n, __CLPK_doublereal* a,
+__CLPK_integer* lda, __CLPK_integer* ipiv, __CLPK_integer* info);
-int dgetri_(__CLPK_integer* n, __CLPK_doublereal* a, __CLPK_integer* lda,
- __CLPK_integer* ipiv, __CLPK_doublereal* work,
- __CLPK_integer* lwork, __CLPK_integer* info);
+int
+dgetri_ (__CLPK_integer* n, __CLPK_doublereal* a, __CLPK_integer* lda,
+__CLPK_integer* ipiv, __CLPK_doublereal* work,
+__CLPK_integer* lwork, __CLPK_integer* info);
-int dgetrs_(char* trans, __CLPK_integer* n, __CLPK_integer* nrhs,
- __CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_integer* ipiv,
- __CLPK_doublereal* b, __CLPK_integer* ldb, __CLPK_integer* info);
+int
+dgetrs_ (char* trans, __CLPK_integer* n, __CLPK_integer* nrhs,
+__CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_integer* ipiv,
+__CLPK_doublereal* b, __CLPK_integer* ldb, __CLPK_integer* info);
-int dsygv_(__CLPK_integer* itype, char* jobz, char* uplo, __CLPK_integer* n,
- __CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_doublereal* b,
- __CLPK_integer* ldb, __CLPK_doublereal* w, __CLPK_doublereal* work,
- __CLPK_integer* lwork, __CLPK_integer* info);
+int
+dsygv_ (__CLPK_integer* itype, char* jobz, char* uplo, __CLPK_integer* n,
+__CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_doublereal* b,
+__CLPK_integer* ldb, __CLPK_doublereal* w, __CLPK_doublereal* work,
+__CLPK_integer* lwork, __CLPK_integer* info);
#endif // end !_WIN32
#endif // end !__APPLE__
-void mem_error() {
- fprintf(stderr, "CM\n");
- exit(1);
+void
+mem_error ()
+{
+ fprintf (stderr, "CM\n");
+ exit (1);
}
-void inverse_error(char* procname, int info) {
- if (info < 0) {
- fprintf(stderr, "error (%s): illegal argument %d\n", procname, -info);
- } else {
- fprintf(stderr, "error (%s): singular matrix %d\n", procname, info);
- }
- exit(1);
+void
+inverse_error (char* procname, int info)
+{
+ if (info < 0)
+ {
+ fprintf (stderr, "error (%s): illegal argument %d\n", procname, -info);
+ }
+ else
+ {
+ fprintf (stderr, "error (%s): singular matrix %d\n", procname, info);
+ }
+ exit (1);
}
-void eigx_(double* pmat, double* ev, __CLPK_integer* n) {
- char jobz = 'N';
- char uplo = 'L';
- __CLPK_integer ldz = *n;
- __CLPK_integer info;
- double* z;
- double* work;
- z = (double*)malloc(ldz * ldz * sizeof(double));
- if (!z) {
- mem_error();
- }
- work = (double*)malloc(3 * ldz * sizeof(double));
- if (!work) {
+void
+eigx_ (double* pmat, double* ev, __CLPK_integer* n)
+ {
+ char jobz = 'N';
+ char uplo = 'L';
+ __CLPK_integer ldz = *n;
+ __CLPK_integer info;
+ double* z;
+ double* work;
+ z = (double*)malloc(ldz * ldz * sizeof(double));
+ if (!z)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(3 * ldz * sizeof(double));
+ if (!work)
+ {
+ free(z);
+ mem_error();
+ }
+ dspev_(&jobz, &uplo, n, pmat, ev, z, &ldz, work, &info);
free(z);
- mem_error();
- }
- dspev_(&jobz, &uplo, n, pmat, ev, z, &ldz, work, &info);
- free(z);
- free(work);
- if (info) {
+ free(work);
+ if (info)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "INFO: %d\n", info);
+ fprintf(stderr, "INFO: %d\n", info);
#else
- fprintf(stderr, "INFO: %ld\n", info);
+ fprintf(stderr, "INFO: %ld\n", info);
#endif
- exit(1);
+ exit(1);
+ }
}
-}
-void eigxv_(double* pmat, double* eval, double* evec, __CLPK_integer* n) {
- char jobz = 'V';
- char uplo = 'L';
- __CLPK_integer ldz = *n;
- __CLPK_integer info;
- double* work = (double*)malloc(3 * ldz * sizeof(double));
- if (!work) {
- mem_error();
- }
- dspev_(&jobz, &uplo, n, pmat, eval, evec, &ldz, work, &info);
- free(work);
- if (info) {
+void
+eigxv_ (double* pmat, double* eval, double* evec, __CLPK_integer* n)
+ {
+ char jobz = 'V';
+ char uplo = 'L';
+ __CLPK_integer ldz = *n;
+ __CLPK_integer info;
+ double* work = (double*)malloc(3 * ldz * sizeof(double));
+ if (!work)
+ {
+ mem_error();
+ }
+ dspev_(&jobz, &uplo, n, pmat, eval, evec, &ldz, work, &info);
+ free(work);
+ if (info)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "INFO: %d\n", info);
+ fprintf(stderr, "INFO: %d\n", info);
#else
- fprintf(stderr, "INFO: %ld\n", info);
+ fprintf(stderr, "INFO: %ld\n", info);
#endif
- exit(1);
+ exit(1);
+ }
}
-}
-void cdc_(double* pmat, __CLPK_integer* n) {
- char uplo = 'L';
- __CLPK_integer lda = *n;
- __CLPK_integer info;
- dpotrf_(&uplo, n, pmat, &lda, &info);
- if (info) {
- if (info < 0) {
+void
+cdc_ (double* pmat, __CLPK_integer* n)
+ {
+ char uplo = 'L';
+ __CLPK_integer lda = *n;
+ __CLPK_integer info;
+ dpotrf_(&uplo, n, pmat, &lda, &info);
+ if (info)
+ {
+ if (info < 0)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "error (CDC): illegal argument %d\n", -info);
+ fprintf(stderr, "error (CDC): illegal argument %d\n", -info);
#else
- fprintf(stderr, "error (CDC): illegal argument %ld\n", -info);
+ fprintf(stderr, "error (CDC): illegal argument %ld\n", -info);
#endif
- } else {
+ }
+ else
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "error (CDC): minor not positive definite %d\n", info);
+ fprintf(stderr, "error (CDC): minor not positive definite %d\n", info);
#else
- fprintf(stderr, "error (CDC): minor not positive definite %ld\n", info);
+ fprintf(stderr, "error (CDC): minor not positive definite %ld\n", info);
#endif
- }
- exit(1);
+ }
+ exit(1);
+ }
}
-}
-void inverse_(double* pmat, __CLPK_integer* n) {
- __CLPK_integer lwork = (*n) * (*n);
- __CLPK_integer info;
- __CLPK_integer* ipiv;
- double* work;
- ipiv = (__CLPK_integer*)malloc((*n) * sizeof(__CLPK_integer));
- if (!ipiv) {
- mem_error();
- }
- work = (double*)malloc(lwork * sizeof(double));
- if (!work) {
- free(ipiv);
- mem_error();
- }
- dgetrf_(n, n, pmat, n, ipiv, &info);
- if (info) {
+void
+inverse_ (double* pmat, __CLPK_integer* n)
+ {
+ __CLPK_integer lwork = (*n) * (*n);
+ __CLPK_integer info;
+ __CLPK_integer* ipiv;
+ double* work;
+ ipiv = (__CLPK_integer*)malloc((*n) * sizeof(__CLPK_integer));
+ if (!ipiv)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(lwork * sizeof(double));
+ if (!work)
+ {
+ free(ipiv);
+ mem_error();
+ }
+ dgetrf_(n, n, pmat, n, ipiv, &info);
+ if (info)
+ {
+ free(ipiv);
+ free(work);
+ inverse_error("INVERSE", info);
+ exit(1);
+ }
+ dgetri_(n, pmat, n, ipiv, work, &lwork, &info);
free(ipiv);
free(work);
- inverse_error("INVERSE", info);
- exit(1);
- }
- dgetri_(n, pmat, n, ipiv, work, &lwork, &info);
- free(ipiv);
- free(work);
- if (info) {
- inverse_error("INVERSE", info);
+ if (info)
+ {
+ inverse_error("INVERSE", info);
+ }
}
-}
-void solve_(double* pmat, double* v, __CLPK_integer* n) {
- __CLPK_integer ldb = *n;
- char trans = 'N';
- __CLPK_integer nrhs = 1;
- double* work;
- __CLPK_integer* ipiv;
- __CLPK_integer info;
- ipiv = (__CLPK_integer*)malloc(ldb * sizeof(__CLPK_integer));
- if (!ipiv) {
- mem_error();
- }
- work = (double*)malloc(ldb * ldb * sizeof(double));
- if (!work) {
- free(ipiv);
- mem_error();
- }
- dgetrf_(n, n, pmat, n, ipiv, &info);
- if (info) {
+void
+solve_ (double* pmat, double* v, __CLPK_integer* n)
+ {
+ __CLPK_integer ldb = *n;
+ char trans = 'N';
+ __CLPK_integer nrhs = 1;
+ double* work;
+ __CLPK_integer* ipiv;
+ __CLPK_integer info;
+ ipiv = (__CLPK_integer*)malloc(ldb * sizeof(__CLPK_integer));
+ if (!ipiv)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(ldb * ldb * sizeof(double));
+ if (!work)
+ {
+ free(ipiv);
+ mem_error();
+ }
+ dgetrf_(n, n, pmat, n, ipiv, &info);
+ if (info)
+ {
+ free(ipiv);
+ free(work);
+ inverse_error("SOLVE", info);
+ }
+ dgetrs_(&trans, n, &nrhs, pmat, n, ipiv, v, &ldb, &info);
free(ipiv);
free(work);
- inverse_error("SOLVE", info);
+ if (info < 0)
+ {
+ inverse_error("SOLVE", info);
+ }
}
- dgetrs_(&trans, n, &nrhs, pmat, n, ipiv, v, &ldb, &info);
- free(ipiv);
- free(work);
- if (info < 0) {
- inverse_error("SOLVE", info);
- }
-}
-void geneigsolve_(double* pmat, double* qmat, double* eval, __CLPK_integer* n) {
- __CLPK_integer lwork = (*n) * (*n);
- double* work = (double*)malloc(lwork * sizeof(double));
- __CLPK_integer wood_elf = 1; // Sameer Merchant memorial temporary variable
- __CLPK_integer info;
- if (!work) {
- mem_error();
- }
- dsygv_(&wood_elf, "V", "U", n, pmat, n, qmat, n, eval, work, &lwork, &info);
+void
+geneigsolve_ (double* pmat, double* qmat, double* eval, __CLPK_integer* n)
+ {
+ __CLPK_integer lwork = (*n) * (*n);
+ double* work = (double*)malloc(lwork * sizeof(double));
+ __CLPK_integer wood_elf = 1; // Sameer Merchant memorial temporary variable
+ __CLPK_integer info;
+ if (!work)
+ {
+ mem_error();
+ }
+ dsygv_(&wood_elf, "V", "U", n, pmat, n, qmat, n, eval, work, &lwork, &info);
free(work);
if (info && (info <= 2 * (*n))) {
if (info < 0) {
diff --git a/src/eigensrc/exclude.c b/src/eigensrc/exclude.c
index c5f14e7..aca0113 100644
--- a/src/eigensrc/exclude.c
+++ b/src/eigensrc/exclude.c
@@ -4,7 +4,10 @@
#define MAXRGN 1000
-void excluderegions(char *xregionname, SNP **snps, int nsnps, char *deletesnpoutname) {
+void
+excluderegions (char *xregionname, SNP **snps, int nsnps,
+ char *deletesnpoutname)
+{
FILE *fp;
int chr[MAXRGN];
@@ -15,84 +18,101 @@ void excluderegions(char *xregionname, SNP **snps, int nsnps, char *deletesnpout
char *spt[MAXFF];
int nsplit, nrgn, i, j;
- if ( (fp = fopen(xregionname, "r")) == NULL ) {
- printf("excluderegions: can't open file %s\n", xregionname);
- return;
- }
+ if ((fp = fopen (xregionname, "r")) == NULL)
+ {
+ printf ("excluderegions: can't open file %s\n", xregionname);
+ return;
+ }
- for(i=0;i<MAXRGN;i++) {
+ for (i = 0; i < MAXRGN; i++)
+ {
- if ( fgets(line,MAXSTR,fp) == NULL )
- break;
+ if (fgets (line, MAXSTR, fp) == NULL)
+ break;
- nsplit = splitup(line, spt, MAXFF);
- if ( nsplit != 3 )
- continue;
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit != 3)
+ continue;
- chr[i] = atoi(spt[0]);
- lo[i] = atoi(spt[1]);
- hi[i] = atoi(spt[2]);
+ chr[i] = atoi (spt[0]);
+ lo[i] = atoi (spt[1]);
+ hi[i] = atoi (spt[2]);
- }
- fclose(fp);
+ }
+ fclose (fp);
nrgn = i;
-
- for(i=0;i<nsnps;i++) {
- SNP *cupt = snps[i];
- for(j=0;j<nrgn;j++) {
- if ( cupt->chrom == chr[j] && cupt->physpos >= lo[j] && cupt->physpos <= hi[j] ) {
- cupt->ignore = YES;
- if ( deletesnpoutname != NULL ) {
- logdeletedsnp(cupt->ID, "xregion",deletesnpoutname);
+
+ for (i = 0; i < nsnps; i++)
+ {
+ SNP *cupt = snps[i];
+ for (j = 0; j < nrgn; j++)
+ {
+ if (cupt->chrom == chr[j] && cupt->physpos >= lo[j]
+ && cupt->physpos <= hi[j])
+ {
+ cupt->ignore = YES;
+ if (deletesnpoutname != NULL)
+ {
+ logdeletedsnp (cupt->ID, "xregion", deletesnpoutname);
+ }
+ }
}
- }
}
- }
return;
}
-void hwfilter(SNP **snps, int nsnps, int nindiv, double nhwfilter, char *deletesnpoutname) {
+void
+hwfilter (SNP **snps, int nsnps, int nindiv, double nhwfilter,
+ char *deletesnpoutname)
+{
int i, k;
-
- for(i=0;i<nsnps;i++) {
- int num = 0, den = 0, het = 0, n0 = 0, n1 = 0, n2 = 0, nsamples;
- double p, Q, stdv;
- SNP *cupt = snps[i];
-
- for(k=0;k<nindiv;k++) {
- int g = getgtypes(cupt, k);
- if ( g >=0 ) {
- num += g;
- den += 2;
- }
- if ( g == 1 ) {
- het++;
- n1++;
- }
- else if ( g == 0 ) {
- n0++;
- }
- else if ( g == 2 ) {
- n2++;
- }
- }
- if ( (nsamples=den/2) == 0 )
- continue;
- p = (double) num/den;
- Q = 2*p*(1-p);
- stdv = sqrt(Q*(1-Q)/nsamples);
- if ( fabs( (double)het/nsamples - Q ) > nhwfilter*stdv ) {
- printf("SNP %s removed by Hardy-Weinberg filter\n", cupt->ID);
- cupt->ignore = YES;
- if ( deletesnpoutname != NULL ) {
- logdeletedsnp(cupt->ID, "hwfilt",deletesnpoutname);
- }
- }
- }
+ for (i = 0; i < nsnps; i++)
+ {
+ int num = 0, den = 0, het = 0, n0 = 0, n1 = 0, n2 = 0, nsamples;
+ double p, Q, stdv;
+ SNP *cupt = snps[i];
+
+ for (k = 0; k < nindiv; k++)
+ {
+ int g = getgtypes (cupt, k);
+ if (g >= 0)
+ {
+ num += g;
+ den += 2;
+ }
+ if (g == 1)
+ {
+ het++;
+ n1++;
+ }
+ else if (g == 0)
+ {
+ n0++;
+ }
+ else if (g == 2)
+ {
+ n2++;
+ }
+ }
+ if ((nsamples = den / 2) == 0)
+ continue;
+ p = (double) num / den;
+ Q = 2 * p * (1 - p);
+ stdv = sqrt (Q * (1 - Q) / nsamples);
+ if (fabs ((double) het / nsamples - Q) > nhwfilter * stdv)
+ {
+ printf ("SNP %s removed by Hardy-Weinberg filter\n", cupt->ID);
+ cupt->ignore = YES;
+ if (deletesnpoutname != NULL)
+ {
+ logdeletedsnp (cupt->ID, "hwfilt", deletesnpoutname);
+ }
+ }
+ }
}
diff --git a/src/eigensrc/fffpca.c b/src/eigensrc/fffpca.c
index 1a7b4fe..4857e1f 100644
--- a/src/eigensrc/fffpca.c
+++ b/src/eigensrc/fffpca.c
@@ -30,93 +30,93 @@
Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
+ */
#define WVERSION "13002"
/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
+ Simple eigenvector analysis
+ Options to look at groups (simple ANOVA)
+ Weights allowed for individuals
+ missing mode
+ dotpops added
+ recompiled with new twtail. Output form at changed
+ Cleaned up twestxx
+ fancynorm mode (divide by sqrt(p*(1-p))
+ poplistname supported. Eigenanalysis just on individuals in population
+ But all individuals figure in eigenvector output
+ New way of computing effective marker size (twl2mode)
+ popdifference implemented
+ ldregression ldlimit (genetic distance in Morgans)
+ nostatslim added
+ dotpop has new format if many groups
+ uses new I/O
+ Supports packmode
+ Alkes style outlier removal added
+ Only half XTX computed
+ xdata (huge array) removed
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
+ fst calculation added
+ popsizelimit added
+ divergence added (not useful?)
-SNPs discarded if no data.
-Phylipfile now supported
+ SNPs discarded if no data.
+ Phylipfile now supported
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
+ Preparations for parallelization made
+ Various fixups for EIGENSTRAT and altnormstyle
-output capability added (like convertf)
+ output capability added (like convertf)
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
+ bug fixed (a last iteration needed for outlier removal)
+ bug fixed (numindivs unlimited)
+ output files fixed up (NULL OK)
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
+ Many Alkes style options added
+ Support for outliername added (outlier info)
+ familyname added (ped files)
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+ bugfix: jackrat dies (outlier removes all of population)
+ bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
+ nrows, ncols output added
+ nrows, ncols set each outlier iteration
+ indivs with no data removed
-writesnpeig added
+ writesnpeig added
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
+ bugfix: popsize of 1 no anova done
+ minallelecnt added
+ chrom: added
+ latest greatest handling of chromosome number added.
+ bad bugfix: numvalidgtypes
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
+ checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
+ pubmean added
-fst on X
-fst std errors now fixed
+ fst on X
+ fst std errors now fixed
-bad bug fixed (outfiles changed indivmarkers) ...
+ bad bug fixed (outfiles changed indivmarkers) ...
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
+ fstdetailsname added
+ fsthiprecision added
+ bug fixed (getrawcolx)
-bad bug fix. xtypes not allocated correctly
+ bad bug fix. xtypes not allocated correctly
-version compatible with Mac
-XTX.dbg commented out
+ version compatible with Mac
+ XTX.dbg commented out
-outliermode added
+ outliermode added
-regmode added
-maxpops parametric. Use easymode if large
+ regmode added
+ maxpops parametric. Use easymode if large
-id2pops added
+ id2pops added
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-*/
+ Threading added Chris Chang)
+ fastmode (Kevin Galinski)
+ */
#if _WIN32
// just in case we try a Windows port in the future
@@ -139,222 +139,285 @@ fastmode (Kevin Galinski)
#define MAXSTR 512
#define MAXPOPS 1000
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *parname = NULL;
+char *twxtabname = NULL;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int fastdim = -1 ;
-int fastiter= -1 ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
+SNP **snpmarkers;
+
+int numsnps, numindivs;
+int numeigs = 10; /// default
+int markerscore = NO;
+int maxpops = 100;
+int seed = 0;
+int chisqmode = NO; // approx p-value better to use F-stat
+int missingmode = NO;
+int shrinkmode = NO;
+int dotpopsmode = YES;
+int noxdata = YES; /* default as pop structure dubious if Males and females */
+int fstonly = NO;
+int pcorrmode = NO;
+int pcpopsonly = YES;
+int nostatslim = 10;
+int znval = -1;
+int popsizelimit = -1;
+int altnormstyle = YES; // affects subtle details in normalization formula
+int minallelecnt = 1;
+int maxmissing = 9999999;
+int lopos = -999999999, hipos = 999999999; // use with xchrom
+
+int packout = -1;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+extern int packmode;
+extern int numchrom;
+extern int fancynorm;
+extern int verbose;
+int ogmode = NO;
+int fsthiprec = NO;
+int inbreed = NO; // for fst
+int easymode = NO;
+int fastmode = NO;
+int fastdim = -1;
+int fastiter = -1;
+int regmode = NO;
+
+int numoutliter = 5, numoutleigs = 10, outliermode = 0;
+double outlthresh = 6.0;
+OUTLINFO **outinfo;
+char *outinfoname = NULL;
+char *fstdetailsname = NULL;
+
+double plo = .001;
+double phi = .999;
+double pvhit = .001;
+double pvjack = 1.0e-6;
+double *chitot;
+int *xpopsize;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *deletesnpoutname = NULL;
+char *poplistname = NULL;
+char *xregionname = NULL; /* physical positions of SNPs to exclude */
+char *outliername = NULL;
+char *phylipname = NULL;
+char *snpeigname = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *omode = "packedancestrymap";
+char *grmoutname = NULL;
+int grmbinary = NO;
+double blgsize = 0.05; // block size in Morgans */
+char *id2pops = NULL;
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+int killr2 = NO;
+int pubmean = YES; // change default
double nhwfilter = -1.0;
int thread_ct_config = 0;
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
+int randomfillin = NO;
+int usepopsformissing = NO; // if YES popmean is used for missing. Overall mean if all missing for pop
-int xchrom = -1 ;
+int xchrom = -1;
// list of outliers
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+int ldregress = 0;
+double ldlimit = 9999.0; /* default is infinity */
+double ldr2lo = 0.01;
+double ldr2hi = 0.95;
+int ldposlimit = 1000 * 1000 * 1000;
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi);
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum);
+
+char *outputname = NULL;
+char *outputvname = NULL;
+char *weightname = NULL;
+FILE *ofile, *ovfile;
+
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+twnorm (double lam, double m, double n);
+double
+rhoinv (double x, double gam);
+
+void
+readcommands (int argc, char **argv);
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+fvadjust (double *rr, int n, double *pmean, double *fancy);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+int
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1);
+int
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1);
+void
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows);
+
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+double
+anova1 (double *vec, int len, int *xtypes, int numeg);
+double
+anova (double *vec, int len, int *xtypes, int numeg);
+void
+publishit (char *sss, int df, double chi);
+
+void
+setmiss (SNP **snpm, int numsnps);
+void
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
+void
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
+void
+printxcorr (double *X, int nrows, Indiv **indxx);
+
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
+void
+addoutersym (double *X, double *v, int n);
+void
+symit (double *X, int n);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
+void
+jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
+void
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf);
+void
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int marker_ct,
+ uint32_t indiv_ct);
+void
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols);
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+void
+fixwt (SNP **snpm, int nsnp, double val);
+void
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex);
+void
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname);
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile) ;
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile);
uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
+triangle_divide (int64_t cur_prod, int32_t modif)
{
// return smallest integer vv for which (vv * (vv + modif)) is no smaller
// than cur_prod, and neither term in the product is negative. (Note the
// lack of a divide by two; cur_prod should also be double its "true" value
// as a result.)
int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
+ if (cur_prod == 0)
+ {
+ if (modif < 0)
+ {
+ return -modif;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ vv = (int64_t) sqrt ((double) cur_prod);
+ while ((vv - 1) * (vv + modif - 1) >= cur_prod)
+ {
+ vv--;
+ }
+ while (vv * (vv + modif) < cur_prod)
+ {
+ vv++;
}
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
return vv;
}
void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
+parallel_bounds (uint32_t ct, int32_t start, uint32_t parallel_idx,
+ uint32_t parallel_tot, int32_t* bound_start_ptr,
+ int32_t* bound_end_ptr)
{
int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
+ int64_t ct_tot = ((int64_t) ct) * (ct + modif);
+ *bound_start_ptr = triangle_divide ((ct_tot * parallel_idx) / parallel_tot,
+ modif);
+ *bound_end_ptr = triangle_divide (
+ (ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
}
// set align to 1 for no alignment
void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
+triangle_fill (uint32_t* target_arr, uint32_t ct, uint32_t pieces,
+ uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start,
+ uint32_t align)
{
int32_t modif = 1 - start * 2;
uint32_t cur_piece = 1;
@@ -364,31 +427,34 @@ triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t paral
int32_t ubound;
uint32_t uii;
uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
+ parallel_bounds (ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
// x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
align *= 2;
align_m1 = align - 1;
target_arr[0] = lbound;
target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
+ cur_prod = ((int64_t) lbound) * (lbound + modif);
+ ct_tr = (((int64_t) ubound) * (ubound + modif) - cur_prod) / pieces;
+ while (cur_piece < pieces)
+ {
+ cur_prod += ct_tr;
+ lbound = triangle_divide (cur_prod, modif);
+ uii = (lbound - ((int32_t) start)) & align_m1;
+ if ((uii) && (uii != align_m1))
+ {
+ lbound = start + ((lbound - ((int32_t) start)) | align_m1);
+ }
+ // lack of this check caused a nasty bug earlier
+ if (((uint32_t) lbound) > ct)
+ {
+ lbound = ct;
+ }
+ target_arr[cur_piece++] = lbound;
+ }
}
void
-symit2(double* XTX, uintptr_t nrows)
+symit2 (double* XTX, uintptr_t nrows)
{
// unpacks LOWER-triangle-only symmetric matrix representation into regular
// square matrix.
@@ -396,39 +462,48 @@ symit2(double* XTX, uintptr_t nrows)
uintptr_t col_idx;
double* read_col;
double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
+ if (nrows < 3)
+ {
+ if (nrows < 2)
+ {
+ return;
+ }
+ // special case, need to avoid overlapping memcpy
+ XTX[3] = XTX[2];
+ XTX[2] = XTX[1];
return;
}
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
+ for (row_idx = nrows - 1; row_idx; row_idx--)
+ {
+ memcpy (&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]),
+ (row_idx + 1) * sizeof(double));
+ }
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ read_col = &(XTX[row_idx]);
+ write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
+ for (col_idx = row_idx + 1; col_idx < nrows; col_idx++)
+ {
+ *write_ptr++ = read_col[col_idx * nrows];
+ }
}
- }
}
void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
+copy_transposed (double* orig_matrix, uintptr_t orig_row_ct,
+ uintptr_t orig_col_ct, double* transposed_matrix)
{
uintptr_t new_row_idx;
uintptr_t new_col_idx;
double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++)
+ {
+ orig_col_ptr = &(orig_matrix[new_row_idx]);
+ for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++)
+ {
+ *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ }
}
- }
}
// make these file scope so multithreading works
@@ -442,2013 +517,2319 @@ static double* g_weights;
static uintptr_t* g_binary_cols;
static uintptr_t* g_binary_mmask;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww, *evals ;
+ char sss[MAXSTR];
+ char **eglist;
+ int numeg;
+ int i, j, k, k1, k2, pos;
+ int *vv;
+ SNP *cupt;
+ Indiv *indx;
+ double y1 = 0, y2, y2l, y, y3;
+
+ int n0, n1, nkill;
+
+ int nindiv = 0;
+ double ychi, tail, tw;
+ int nignore, numrisks = 1;
+ double *xrow, *xpt;
+ SNP **xsnplist;
+ Indiv **xindlist;
+ int *xindex, *xtypes = NULL;
+ int nrows, ncols, m, nused;
+ double *XTX, *cc, *evecs, *ww, *evals;
double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
+ double *lambda, *esize;
+ double zn, zvar;
+ double *fvecs, *fxvecs, *fxscal;
+ double *ffvecs;
+ int weightmode = NO;
+ double ynrows;
+ int t, tt;
+ double *xmean, *xfancy;
+ double *ldvv = NULL, ynumsnps = 0; // for grm
+ int *ldsnpbuff = NULL;
+ int lastldchrom, numld;
+ double *fstans, *fstsd;
+ double *inbans, *inbsd;
+
+ int chrom;
+ int outliter, numoutiter, *badlist, nbad;
+ FILE *outlfile, *phylipfile;
+ double *eigkurt, *eigindkurt;
+ double *wmean;
+ char **elist;
+ double *shrink;
+ double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL;
+ int kk;
+ double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq;
+
+ int xblock;
int blocksize = 1024;
double *tblock = NULL;
int* binary_rawcol = NULL;
uintptr_t* binary_cols = NULL;
uintptr_t* binary_mmask = NULL;
- OUTLINFO *outpt ;
+ OUTLINFO *outpt;
pthread_t threads[MAX_THREADS];
uint32_t thread_ct;
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
+ readcommands (argc, argv);
+ printf ("## smartpca version: %s\n", WVERSION);
+ packmode = YES;
+ setomode (&outputmode, omode);
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
+ if (parname == NULL)
+ return 0;
+ if (xchrom == (numchrom + 1))
+ noxdata = NO;
- if (fastmode) {
- if (fastiter < 0) fastiter = numeigs;
- if (fastdim < 0) fastdim = 2*numeigs;
- }
+ if (fastmode)
+ {
+ if (fastiter < 0)
+ fastiter = numeigs;
+ if (fastdim < 0)
+ fastdim = 2 * numeigs;
+ }
-/**
- if (fastmode) {
+ /**
+ if (fastmode) {
printf("fastmode => easymode\n") ;
easymode = YES ;
- }
-*/
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
-
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
+ }
+ */
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
+ if (usepopsformissing)
+ {
+ printf ("usepopsformissing => easymode\n");
+ easymode = YES;
+ }
- nostatslim = MAX(nostatslim, 3) ;
+ if (deletesnpoutname != NULL)
+ { /* remove because snplog opens in append mode */
+ char buff[256];
+ sprintf (buff, "rm -f %s", deletesnpoutname);
+ system (buff);
+ }
- outlfile = ofile = stdout;
+ if (fstonly)
+ {
+ printf ("fstonly\n");
+ numeigs = 0;
+ numoutliter = 0;
+ numoutiter = 0;
+ outputname = NULL;
+ snpeigname = NULL;
+ }
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
+ if (fancynorm)
+ printf ("norm used\n\n");
+ else
+ printf ("no norm used\n\n");
+ if (regmode)
+ printf ("lsqproject used\n");
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
+ nostatslim = MAX(nostatslim, 3);
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
+ outlfile = ofile = stdout;
- numindivs = getindivs(indivname, &indivmarkers) ;
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
+ if (outliername != NULL)
+ openit (outliername, &outlfile, "w");
+ if (fstdetailsname != NULL)
+ openit (fstdetailsname, &fstdetails, "w");
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
+ if ((ldlimit <= 0) || (ldposlimit <= 0))
+ ldregress = 0;
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+ numindivs = getindivs (indivname, &indivmarkers);
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
+ if (id2pops != NULL)
+ {
+ setid2pops (id2pops, indivmarkers, numindivs);
+ }
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
+ k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
}
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
+ else
+ {
+ setstatus (indivmarkers, numindivs, NULL);
+ ZALLOC(eglist, MAXPOPS, char *);
+ numeg = makeeglist (eglist, maxpops, indivmarkers, numindivs);
}
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
+ for (i = 0; i < numeg; i++)
+ {
+ /* printf("%3d %s\n",i, eglist[i]) ; */
}
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
+
+ nindiv = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == YES)
+ ++nindiv;
}
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ chrom = cupt->chrom;
+ if ((noxdata) && (chrom == (numchrom + 1)))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-X", deletesnpoutname);
+ }
+ if (chrom == 0)
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-0", deletesnpoutname);
+ }
+ if (chrom > (numchrom + 1))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-big", deletesnpoutname);
+ }
}
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
+ for (i = 0; i < numsnps; i++)
{
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
+ cupt = snpmarkers[i];
+ pos = nnint (cupt->physpos);
+ if ((xchrom > 0) && (cupt->chrom != xchrom))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "not-chrom", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos < lopos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "lopos", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos > hipos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "hipos", deletesnpoutname);
+ }
+ if (cupt->ignore)
+ continue;
+ if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
+ {
+ printf ("nodata: %20s\n", cupt->ID);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "nodata", deletesnpoutname);
+ }
}
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
+ if (xregionname)
+ {
+ excluderegions (xregionname, snpmarkers, numsnps, deletesnpoutname);
+ }
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
+ if (nhwfilter > 0)
+ {
+ hwfilter (snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
+ }
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
+ ZALLOC(vv, numindivs, int);
+ numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
+ for (i = 0; i < numindivs; ++i)
+ {
+ if (vv[i] == 0)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = YES;
+ }
+ }
+ free (vv);
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
+ numsnps = rmsnps (snpmarkers, numsnps, deletesnpoutname); // rid ignorable snps
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
+ if (missingmode)
+ {
+ setmiss (snpmarkers, numsnps);
+ fancynorm = NO;
+ }
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
+ if (weightname != NULL)
+ {
+ weightmode = YES;
+ getweights (weightname, snpmarkers, numsnps);
+ }
+ if (ldregress > 0)
+ {
+ ZALLOC(ldvv, ldregress*numindivs, double);
+ ZALLOC(ldsnpbuff, ldregress, int); // index of snps
+ }
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
+ ZALLOC(xindex, numindivs, int);
+ ZALLOC(xindlist, numindivs, Indiv *);
+ ZALLOC(xsnplist, numsnps, SNP *);
+ if (popsizelimit > 0)
+ {
+ setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
+ }
/* Load non-ignored individuals into xindlist,xindex:
* xindex[i] = index into indivmarkers
* xindlist[i] = pointer to Indiv struct */
- ZALLOC(xtypes, numindivs, int) ;
-
-
+ ZALLOC(xtypes, numindivs, int);
/* Load non-ignored SNPs into xsnplist:
* xsnplist[i] = pointer to SNP struct */
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
+ printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);
- if (fastmode) {
+ if (fastmode)
+ {
// temporary
- if (easymode) {
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- indx -> flag = indx -> ignore ;
- indx -> ignore = YES ;
- }
- for (i=0; i<nrows; ++i) {
- indx = xindlist[i] ;
- indx -> ignore = NO ;
+ if (easymode)
+ {
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ indx->flag = indx->ignore;
+ indx->ignore = YES;
+ }
+ for (i = 0; i < nrows; ++i)
+ {
+ indx = xindlist[i];
+ indx->ignore = NO;
// xindex[i] = i ;
- }
+ }
-/**
- printf("old numindivs: %d\n", numindivs) ;
- numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
- printf("new numindivs: %d\n", numindivs) ;
-*/
- }
+ /**
+ printf("old numindivs: %d\n", numindivs) ;
+ numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
+ printf("new numindivs: %d\n", numindivs) ;
+ */
+ }
// end temporary hack
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
+ setgval (xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols);
// side-effect monomorphic snps -> ignore
- ZALLOC(evals, numeigs, double) ;
- ZALLOC(evecs, numeigs*nrows, double) ;
+ ZALLOC(evals, numeigs, double);
+ ZALLOC(evecs, numeigs*nrows, double);
- kjg_fpca(numeigs, fastdim, fastiter,
- evals, evecs);
-
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- indx -> ignore = indx -> flag ;
- }
- printf("##bug: \n") ; printmat(evals, 1, numeigs) ; printmat(evecs, 1, 20) ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
+ kjg_fpca (numeigs, fastdim, fastiter, evals, evecs);
- transpose(evecs, evecs, nrows, numeigs) ;
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = indx->flag;
+ }
+ printf ("##bug: \n");
+ printmat (evals, 1, numeigs);
+ printmat (evecs, 1, 20);
+
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
+ }
+ fclose (ovfile);
+ }
- printevecs(xsnplist, indivmarkers, xindlist,
- numindivs, ncols, nrows, numeigs,
- evecs, evals, ofile) ;
+ transpose (evecs, evecs, nrows, numeigs);
+ printevecs (xsnplist, indivmarkers, xindlist, numindivs, ncols, nrows,
+ numeigs, evecs, evals, ofile);
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
+ printf ("end of smartpca(fastmode)\n");
+ return 0;
-}
-
+ }
/* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
+ ZALLOC(xmean, ncols, double);
+ ZALLOC(xfancy, ncols, double);
+
+ ZALLOC(XTX, nrows*nrows, double);
+ ZALLOC(evecs, nrows*nrows, double);
+ if ((!usepopsformissing) && (ldregress == 0))
+ {
+ // should not use lookup table if
+ // - usepopsformissing is set (since each population may have a different
+ // mean), or
+ // - ldregress > 0
#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
+ blocksize = 20;
+ ZALLOC(partial_sum_lookup_buf, 131072, double);
#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
+ blocksize = 10;
+ ZALLOC(partial_sum_lookup_buf, 65536, double);
#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
+ ZALLOC(binary_rawcol, nrows, int);
+ ZALLOC(binary_cols, nrows, uintptr_t);
+ ZALLOC(binary_mmask, nrows, uintptr_t);
+ ZALLOC(tblock, 3 * blocksize, double);
+ }
+ else
+ {
+ ZALLOC(tblock, nrows*blocksize, double);
+ }
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
+ ZALLOC(lambda, nrows, double);
+ ZALLOC(esize, nrows, double);
+ ZALLOC(cc, (nrows > 3)? nrows : 3, double);
+ ZALLOC(ww, nrows, double);
+ ZALLOC(badlist, nrows, int);
- blocksize = MIN(blocksize, ncols) ;
+ blocksize = MIN(blocksize, ncols);
// xfancy is multiplier for column xmean is mean to take off
// badlist is list of rows to delete (outlier removal)
- numoutiter = 1 ;
+ numoutiter = 1;
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
+ if (numoutliter >= 1)
+ {
+ numoutiter = numoutliter + 1;
+ ZALLOC(outinfo, nrows, OUTLINFO *);
+ for (k = 0; k < nrows; k++)
+ {
+ ZALLOC(outinfo[k], 1, OUTLINFO);
+ }
+ /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
+ setoutliermode (outliermode);
+ }
+ else
+ setoutliermode (2);
// try to autodetect number of (virtual) processors, and use that number to
// set the thread count. allow the user to override this in the future
#if _WIN32
SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
+ if (thread_ct_config <= 0)
+ {
+ GetSystemInfo(&sysinfo);
+ thread_ct = sysinfo.dwNumberOfProcessors;
+ }
+ else
+ {
+ thread_ct = thread_ct_config;
+ }
#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
+ if (thread_ct_config <= 0)
+ {
+ i = sysconf (_SC_NPROCESSORS_ONLN);
+ if (i == -1)
+ {
+ thread_ct = 1;
+ }
+ else
+ {
+ thread_ct = i;
+ }
}
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
+ else
+ {
+ thread_ct = thread_ct_config;
}
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
+#endif
+ if (thread_ct > 8)
+ {
+ if (thread_ct > MAX_THREADS)
+ {
+ thread_ct = MAX_THREADS;
+ }
+ else
+ {
+ thread_ct--;
+ }
}
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ if (thread_ct > nrows * 2)
+ {
+ thread_ct = nrows / 2;
+ if (!thread_ct)
+ {
+ thread_ct = 1;
+ }
}
+ printf ("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1) ? "" : "s",
+ (partial_sum_lookup_buf) ? ", and partial sum lookup algorithm" : "");
+ triangle_fill (g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
+ nkill = 0;
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
+ for (outliter = 1; outliter <= numoutiter; ++outliter)
+ {
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
+ if (fstonly)
+ {
+ setidmat (XTX, nrows);
+ vclear (lambda, 1.0, nrows);
+ break;
+ }
+ if (outliter > 1)
+ {
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ }
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
+ vzero (XTX, (nrows * (nrows + 1)) / 2);
+ xblock = 0;
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
+ vzero (xmean, ncols);
+ vclear (xfancy, 1.0, ncols);
- ++xblock ;
- ++nused ;
+ nused = 0;
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
+ }
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
+ numld = 0;
+ lastldchrom = -1;
+ ynumsnps = 0;
+ if (partial_sum_lookup_buf)
+ {
+ for (i = 0; i < nrows; i++)
+ {
+ binary_cols[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ binary_mmask[i] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ vzero (tblock, nrows * blocksize);
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ chrom = cupt->chrom;
+ if (!partial_sum_lookup_buf)
+ {
+ tt = getcolxz (cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy,
+ &n0, &n1);
+ }
+ else
+ {
+ tt = getcolxz_binary1 (binary_rawcol, cc, cupt, xindex, nrows, i,
+ xmean, xfancy, &n0, &n1);
+ }
+
+ t = MIN(n0, n1);
+
+ if ((t < minallelecnt) || (tt > maxmissing) || (tt < 0) || (t == 0))
+ {
+ t = MAX(t, 0);
+ tt = MAX(tt, 0);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "minallelecnt", deletesnpoutname);
+ vzero (cc, nrows);
+ if (nkill < 10)
+ printf (" snp %20s ignored . allelecnt: %5d missing: %5d\n",
+ cupt->ID, t, tt);
+ ++nkill;
+ continue;
+ }
+
+ if (lastldchrom != chrom)
+ numld = 0;
+
+ if (!partial_sum_lookup_buf)
+ {
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, nrows);
+ }
+
+ if (ldregress > 0)
+ {
+
+ t = ldregx (ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi);
+ if (t < 2)
+ {
+ bumpldvv (ldvv, cc, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ ynumsnps += asum2 (ww, nrows) / asum2 (cc, nrows);
+ // don't need to think hard about how cc is normalizes
+ }
+ else
+ {
+ // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
+ bumpldvv (ldvv, ww, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ }
+ copyarr (ww, cc, nrows);
+ }
+ else
+ ++ynumsnps;
+ copyarr (cc, tblock + xblock * nrows, nrows);
+ }
+ else
+ {
+ getcolxz_binary2 (binary_rawcol, binary_cols, binary_mmask,
+ xblock, nrows);
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, 3);
+ }
+ ++ynumsnps;
+ copyarr (cc, &(tblock[xblock * 3]), 3);
+ }
+
+ ++xblock;
+ ++nused;
+
+ /** this is the key code to parallelize */
+ if (xblock == blocksize)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock,
+ nrows, partial_sum_lookup_buf);
+ for (j = 0; j < nrows; j++)
+ {
+ binary_cols[j] = 0;
+ }
+ for (j = 0; j < nrows; j++)
+ {
+ binary_mmask[j] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock,
+ xblock, nrows);
+ vzero (tblock, nrows * blocksize);
+ }
+ xblock = 0;
+ }
+ }
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
+ if (xblock > 0)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock, nrows,
+ partial_sum_lookup_buf);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock, xblock,
+ nrows);
+ }
+ }
+ symit2 (XTX, nrows);
+ printf ("total number of snps killed in pass: %d used: %d\n", nkill,
+ nused);
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
+ if (verbose)
+ {
+ printdiag (XTX, nrows);
+ }
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
+ y = trace (XTX, nrows) / (double) (nrows - 1);
+ if (isnan(y))
+ fatalx ("bad XTX matrix\n");
+ /* printf("trace: %9.3f\n", y) ; */
+ if (y <= 0.0)
+ fatalx ("XTX has zero trace (perhaps no data)\n");
+ vst (XTX, XTX, 1.0 / y, nrows * nrows);
- eigvecs(XTX, lambda, evecs, nrows) ;
+ eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
+ if (outliter > numoutliter)
+ break;
+ // last pass skips outliers
+ numoutleigs = MIN(numoutleigs, nrows - 1);
+ nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
+ outinfo);
+ if (nbad == 0)
+ break;
+ for (i = 0; i < nbad; i++)
+ {
+ j = badlist[i];
+ indx = xindlist[j];
+ outpt = outinfo[j];
+ fprintf (outlfile,
+ "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
+ indx->ID, outliter, outpt->vecno, outpt->score,
+ indx->egroup);
+ indx->ignore = YES;
+ }
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ printf ("number of samples after outlier removal: %d\n", nrows);
+ }
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
+ if (outliername != NULL)
+ fclose (outlfile);
+ dumpgrm (XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname);
+ if (grmoutname != NULL)
+ printf ("grm dumped\n");
- m = numgtz(lambda, nrows) ;
+ m = numgtz (lambda, nrows);
/* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
+ if (m == 0)
+ fatalx ("no data\n");
/* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
+ if (settwxtable (twxtabname) < 0)
+ {
+ printf ("\n## To get Tracy-Widom statistics: recompile smartpca with");
+ printf (" TWTAB correctly specified in Makefile, or\n");
+ printf (" just run twstats (see README file in POPGEN directory)\n");
+ }
else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
+ {
+ /* *** START of code to print Tracy-Widom statistics */
+ printf ("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows,
+ ncols);
+ y = -1.0;
+ printf ("%4s %12s", "#N", "eigenvalue");
+ printf ("%12s", "difference");
+ printf (" %9s %12s", "twstat", "p-value");
+ printf (" %9s", "effect. n");
+ printf ("\n");
+
+ ynrows = (double) nrows;
+
+ for (i = 0; i < m; ++i)
+ {
+ if (fstonly)
+ break;
+ zn = znval;
+ if (zn > 0)
+ zn = MAX(ynrows, zn);
+ tail = dotwcalc (lambda + i, m - i, &tw, &zn, &zvar, nostatslim);
+ esize[i] = zn;
+ printf ("%4d %12.6f", i + 1, lambda[i]);
+ if (i == 0)
+ printf ("%12s", "NA");
+ else
+ printf ("%12.6f", lambda[i] - lambda[i - 1]);
+ if (tail >= 0.0)
+ printf (" %9.3f %12.6g", tw, tail);
+ else
+ printf (" %9s %12s", "NA", "NA");
+ if (zn > 0.0)
+ {
+ printf (" %9.3f", zn);
+ }
+ else
+ {
+ printf (" %9s", "NA");
+ }
+ printf ("\n");
+ }
+ /* END of code to print Tracy-Widom statistics */
}
- /* END of code to print Tracy-Widom statistics */
- }
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
+ numeigs = MIN(numeigs, nrows);
+ numeigs = MIN(numeigs, ncols);
+
+ ZALLOC(shrink, numeigs, double);
+ vclear (shrink, 1.0, numeigs);
+ t = nrows - numeigs;
+ if (t > 0)
+ y1 = asum (lambda + numeigs, t) / (double) t;
+ y = (double) nrows / esize[numeigs];
+ y = MIN(y, 1.0 / y); // gamma
+ for (j = 0; j < numeigs; j++)
+ {
+ if (!shrinkmode)
+ break;
+ if (t <= 0)
+ break;
+ if (esize[j] < 0.1)
+ break;
+ y2 = lambda[j] / y1;
// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
+ y2l = rhoinv (y2, y);
+ if (y2l < 0.0)
+ break;
+ y3 = (y2l - 1.0) / (y2l + y - 1.0);
+ y3 = MIN(y3, 1.0);
+ if (y3 < 0.0)
+ y3 = 1.0;
+ shrink[j] = y3;
+ printf ("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l);
+ }
/* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
/* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
/* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
/* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", lambda[j]);
}
- fclose(ovfile) ;
- }
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
+ fprintf (ofile, "\n");
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
}
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
-
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
+ fclose (ovfile);
}
- }
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(fxvecs, nrows*numeigs, double);
+ ZALLOC(fxscal, numeigs, double);
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(xrow, ncols, double);
+ setfvecs (fvecs, evecs, nrows, numeigs);
- for (i=0; i<nrows; i++) {
+ if (easymode)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ if (pubmean)
+ {
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(elist, numeg, char *);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ calcpopmean (wmean, elist, xpt, eglist, numeg, xtypes, nrows);
+ printf ("eig: %d ", j + 1);
+ printf ("min: %s %9.3f ", elist[0], wmean[0]);
+ printf ("max: %s %9.3f ", elist[numeg - 1], wmean[numeg - 1]);
+ printnl ();
+ for (k = 0; k < numeg; ++k)
+ {
+ printf ("%20s ", elist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
+ }
+ }
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
+ printf ("## easymode set. end of smartpca run\n");
+ return 0;
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * cc[k];
+ }
+ }
+ }
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
+ ZALLOC(eigkurt, numeigs, double);
+ ZALLOC(eigindkurt, numeigs, double);
- for (j=0; j<numeigs; j++) {
+ for (j = 0; j < numeigs; ++j)
+ {
+ eigkurt[j] = kurtosis (ffvecs + j * ncols, ncols);
+ eigindkurt[j] = kurtosis (fvecs + j * nrows, nrows);
+ }
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
+ for (i = 0; i < nrows; i++)
+ {
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
+ loadxdataind (xrow, xsnplist, xindex[i], ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+ for (j = 0; j < numeigs; j++)
+ {
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
+ xpt = ffvecs + j * ncols;
+ y = fxvecs[j * nrows + i] = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
+ }
+ }
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j];
+// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
+ fxscal[j] = 1.0 / sqrt (y); // standard
+ }
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
+ ZALLOC(acoeffs, numindivs*numeigs, double);
+ ZALLOC(bcoeffs, numindivs*numeigs, double);
+ if (partial_sum_lookup_buf)
+ {
+ free (partial_sum_lookup_buf);
+ free (binary_rawcol);
+ free (binary_cols);
+ free (binary_mmask);
+ }
+ free (tblock);
+ if (regmode)
+ {
+ ZALLOC(trow, ncols, double);
+ ZALLOC(rhs, ncols, double);
+ ZALLOC(emat, ncols*numeigs, double);
+ ZALLOC(regans, numeigs, double);
+ /**
+ for (j=0; j<numeigs; ++j) {
+ xpt = ffvecs+j*ncols ;
+ y = asum2(xpt, ncols) ;
+ fxscal[j] = (double) ncols / sqrt(y*y) ;
+ }
+ */
+ }
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
+ for (i = 0; i < numindivs; i++)
+ {
+ if (!regmode)
+ break;
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ copyarr (xrow, trow, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ kk = 0;
+ for (k = 0; k < ncols; ++k)
+ {
+ if (trow[k] < 0)
+ continue;
+ rhs[kk] = xrow[k];
+ for (j = 0; j < numeigs; j++)
+ {
+ emat[kk * numeigs + j] = fxscal[j] * ffvecs[j * ncols + k];
+ }
+ ++kk;
+ }
+ if (kk <= numeigs)
+ {
+ indx->ignore = YES;
+ printf ("%s ignored (insufficient data\n", indx->ID);
+ continue;
+ }
+ regressit (regans, emat, rhs, kk, numeigs);
+ for (j = 0; j < numeigs; ++j)
+ {
+ acoeffs[j * numindivs + i] = regans[j];
+ }
+ }
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j] * vdot (xrow, ffvecs + j * ncols, ncols);
+ if (shrinkmode && (indx->affstatus == YES))
+ y *= shrink[j];
+ bcoeffs[j * numindivs + i] = y;
+ }
+ }
+ if (!regmode)
+ {
+ free (acoeffs);
+ acoeffs = bcoeffs;
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
+ ZALLOC(azq, nrows*numeigs, double);
+ ZALLOC(bzq, nrows*numeigs, double);
+ sqz (azq, acoeffs, numeigs, nrows, xindex);
+ sqz (bzq, bcoeffs, numeigs, nrows, xindex);
+ for (j = 0; j < numeigs; ++j)
+ {
+ if (!regmode)
+ break;
+ apt = azq + j * nrows;
+ bpt = bzq + j * nrows;
+ y = vdot (apt, bpt, nrows) / vdot (apt, apt, nrows);
+ vst (acoeffs + j * numindivs, acoeffs + j * numindivs, y, numindivs);
+ }
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = acoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ if (qtmode)
+ {
+ fprintf (ofile, "%15.6e\n", indx->qval);
+ }
+ else
+ {
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ }
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
+ printf ("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs");
+ for (j = 0; j < numeigs; ++j)
+ {
+ y1 = eigkurt[j];
+ y2 = eigindkurt[j];
+ printf ("%12s %4d %9.3f %9.3f\n", "eigenvector", j + 1, y1, y2);
+ }
// output files
- settersemode(YES) ;
+ settersemode (YES);
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
+ ZALLOC(xpopsize, numeg, int);
+ for (i = 0; i < numeg; i++)
+ {
+ xpopsize[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ ++xpopsize[k];
+ }
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
+ for (i = 0; i < numeg; i++)
+ {
+ printf ("population: %3d %20s %4d", i, eglist[i], xpopsize[i]);
+ if (xpopsize[i] == 0)
+ printf (" ***");
+ printnl ();
+ }
+ if (numeg == 1)
+ dotpopsmode = NO;
- if (numeg==1) dotpopsmode = NO ;
+ if (dotpopsmode == NO)
+ {
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ printxcorr (XTX, nrows, xindlist);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
+ ZALLOC(chitot, numeg*numeg, double);
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
+ dotpops (XTX, eglist, numeg, xtypes, nrows);
+ ZALLOC(fstans, numeg*numeg, double);
+ ZALLOC(fstsd , numeg*numeg, double);
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
+ setinbreed (inbreed);
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ if (inbreed)
+ {
+ ZALLOC(inbans, numeg, double);
+ ZALLOC(inbsd , numeg, double);
+ doinbxx (inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+ printf ("## inbreeding coeffs: inbreed std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %20s %10.4f %10.4f\n", eglist[k1], inbans[k1], inbsd[k1]);
}
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ free (inbans);
+ free (inbsd);
+ }
+
+ dofstxx (fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+
+ if ((phylipname == NULL) && (numeg > 10))
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ if (fsthiprec == NO)
+ {
+ printf (" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ if (fsthiprec == YES)
+ {
+ printf (" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ }
}
- }
+ printf ("\n");
}
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
+ if (fstdetailsname != NULL)
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ fprintf (fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1],
+ eglist[k2], fstans[k1 * numeg + k2],
+ fstsd[k1 * numeg + k2]);
+ }
+ }
+ fprintf (fstdetails, "\n");
}
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
+
+ if (phylipname != NULL)
+ {
+ openit (phylipname, &phylipfile, "w");
+ fprintf (phylipfile, "%6d\n", numeg);
+ sss[10] = CNULL;
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ strncpy (sss, eglist[k1], 10);
+ fprintf (phylipfile, "%10s", sss);
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ y1 = fstans[k1 * numeg + k2];
+ y2 = fstans[k2 * numeg + k1];
+ fprintf (phylipfile, "%6.3f", (0.5 * (y1 + y2)));
+ }
+ fprintf (phylipfile, "\n");
+ }
+ fclose (phylipfile);
}
- fclose(phylipfile) ;
- }
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
+ if ((numeg <= 10) || fstonly)
+ {
+ if (fsthiprec == NO)
+ {
+ printf ("fst *1000:");
+ printnl ();
+ printmatz5 (fstans, eglist, numeg);
+ printnl ();
+ }
+ if (fsthiprec == YES)
+ {
+ printf ("fst *1000000:");
+ printnl ();
+ printmatz10 (fstans, eglist, numeg);
+ printnl ();
+ }
}
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
+ printf ("s.dev * 1000000:\n");
+ vst (fstsd, fstsd, 1000.0, numeg * numeg);
+ printmatz5 (fstsd, eglist, numeg);
+ printnl ();
+ fflush (stdout);
+ if (fstonly)
+ {
+ printf ("##end of smartpca run\n");
+ return 0;
}
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
+ vst (fstsd, fstsd, 1.0 / 1000.0, numeg * numeg);
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "eigenvector %d", j + 1);
+ y = dottest (sss, evecs + j * nrows, eglist, numeg, xtypes, nrows);
+ }
- printxcorr(XTX, nrows, xindlist) ;
+ printf ("\n## Statistical significance of differences beween populations:\n");
+ printf (
+ " pop1 pop2 chisq p-value |pop1| |pop2|\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ if (fstonly)
+ break;
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ ychi = chitot[k1 * numeg + k2];
+ tail = rtlchsq (numeigs, ychi);
+ printf ("popdifference: %20s %20s %12.3f %12.6g", eglist[k1],
+ eglist[k2], ychi, tail);
+ printf (" %5d", xpopsize[k1]);
+ printf (" %5d", xpopsize[k2]);
+ printf ("\n");
+ }
+ }
+ printf ("\n");
+ for (i = 0; i < ncols; i++)
+ {
+ if (markerscore == NO)
+ break;
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+ sprintf (sss, "%s raw", cupt->ID);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "%s subtract sing vec %d", cupt->ID, j + 1);
+ y = vdot (cc, evecs + j * nrows, nrows);
+ vst (ww, evecs + j * nrows, y, nrows);
+ vvm (cc, cc, ww, nrows);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ }
+ }
+ printxcorr (XTX, nrows, xindlist);
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- printf("##end of smartpca run\n") ;
- return 0 ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- phandle *ph ;
- int t ;
+ int i;
+ phandle *ph;
+ int t;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
+ if (parname == NULL)
+ {
+ fprintf (stderr, "no parameters\n");
+ return;
+ }
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
-
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "fastdim:", &fastdim) ;
- getint(ph, "fastiter:", &fastiter) ;
-
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "snpeigname:", &snpeigname);
+ getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "outputvecs:", &outputname);
+ getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
+ getstring (ph, "outputvals:", &outputvname);
+ getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "outliername:", &outliername);
+ getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
+ getstring (ph, "phylipname:", &phylipname);
+ getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
+ getstring (ph, "weightname:", &weightname);
+ getstring (ph, "fstdetailsname:", &fstdetailsname);
+ getstring (ph, "deletsnpoutname:", &deletesnpoutname);
+ getint (ph, "numeigs:", &numeigs);
+ getint (ph, "maxpops:", &maxpops);
+ maxpops = MIN(maxpops, MAXPOPS);
+ getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
+ getint (ph, "markerscore:", &markerscore);
+ getint (ph, "chisqmode:", &chisqmode);
+ getint (ph, "missingmode:", &missingmode);
+ getint (ph, "shrinkmode:", &shrinkmode);
+ getint (ph, "fancynorm:", &fancynorm);
+ getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
+ getint (ph, "dotpopsmode:", &dotpopsmode);
+ getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
+ getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
+ getint (ph, "altnormstyle:", &altnormstyle);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "popgenmode:", &altnormstyle);
+ getint (ph, "noxdata:", &noxdata);
+ getint (ph, "inbreed:", &inbreed);
+ getint (ph, "easymode:", &easymode);
+
+ getint (ph, "fastmode:", &fastmode);
+ getint (ph, "fastdim:", &fastdim);
+ getint (ph, "fastiter:", &fastiter);
+
+ getint (ph, "usepopsformissing:", &usepopsformissing);
+ getint (ph, "regmode:", ®mode);
+ getint (ph, "lsqproject:", ®mode);
+
+ t = -1;
+ getint (ph, "xdata:", &t);
+ if (t >= 0)
+ noxdata = 1 - t;
+ getint (ph, "nostatslim:", &nostatslim);
+ getint (ph, "popsizelimit:", &popsizelimit);
+ getint (ph, "minallelecnt:", &minallelecnt);
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "maxmissing:", &maxmissing);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "pubmean:", &pubmean);
+ getint (ph, "fstonly:", &fstonly);
+ getint (ph, "fsthiprecision:", &fsthiprec);
+
+ getint (ph, "ldregress:", &ldregress);
+ getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
+ getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
+ getint (ph, "ldposlimit:", &ldposlimit); /* bases */
+ getdbl (ph, "ldr2lo:", &ldr2lo);
+ getdbl (ph, "ldr2hi:", &ldr2hi);
+ getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
+ getint (ph, "minleneig:", &nostatslim);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "familynames:", &familynames);
+ getint (ph, "qtmode:", &qtmode);
+
+ getint (ph, "numoutliter:", &numoutliter);
+ getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
+ getint (ph, "numoutleigs", &numoutleigs);
+ getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
+ getdbl (ph, "outlthresh:", &outlthresh);
+ getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
+ getint (ph, "outliermode:", &outliermode); /* test distribution with sample removed. Makes sense for small samples */
+ getdbl (ph, "blgsize:", &blgsize);
+
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getint (ph, "outputgroup:", &ogmode);
+ getstring (ph, "grmoutname:", &grmoutname);
+ getint (ph, "grmbinary:", &grmbinary);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getstring (ph, "twxtabname:", &twxtabname);
+ getstring (ph, "id2pops:", &id2pops);
+
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+ getint (ph, "killr2:", &killr2);
+
+ getint (ph, "numchrom:", &numchrom);
+ getstring (ph, "xregionname:", &xregionname);
+ getdbl (ph, "hwfilter:", &nhwfilter);
+
+ getint (ph, "numthreads:", &thread_ct_config);
+
+ printf ("### THE INPUT PARAMETERS\n");
+ printf ("##PARAMETER NAME: VALUE\n");
+ writepars (ph);
}
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
+int
+fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean force missing to zero */
/* set up fancy norming */
{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
+ double p, ynum, ysum, y, ymean, yfancy = 1.0;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ {
+ return -999;
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ if (fancynorm)
+ {
+ p = 0.5 * ymean; // autosomes
+ if (altnormstyle == NO)
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ yfancy = 1.0 / sqrt (y);
+ }
+ if (fancy != NULL)
+ *fancy = yfancy;
+ return nmiss;
}
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
+int
+fvadjust_binary (int c0, int c1, int nmiss, int n, double* cc, double* pmean,
+ double* fancy)
{
double p, ynum, ysum, y, ymean, yfancy = 1.0;
- if (n == nmiss) {
- return -999;
- }
+ if (n == nmiss)
+ {
+ return -999;
+ }
ynum = n - nmiss;
ysum = c0;
ymean = ysum / ynum;
cc[0] = -ymean;
cc[1] = 1.0 - ymean;
cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
+ if (fancynorm)
+ {
+ p = 0.5 * ymean;
+ if (altnormstyle == NO)
+ {
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ }
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ {
+ yfancy = 1.0 / sqrt (y);
+ }
}
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
+ if (pmean)
+ {
+ *pmean = ymean;
+ }
+ if (fancy)
+ {
+ *fancy = yfancy;
}
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
return nmiss;
}
double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0
// perhaps should rewrite to put xa1 etc in arrays
{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ double *w1;
+ int *xt;
+ int i, k1, k2, k, n, x1, x2;
+ double ylike;
+ double ychi;
+ double *wmean;
+ int imax, imin, *isort;
+ static int ncall = 0;
+
+ char ss1[MAXSTR];
+ char ss2[MAXSTR];
+ double ans, ftail, ftailx, ansx;
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(w1, len + numeg, double);
+ ZALLOC(isort, numeg, int);
+ ZALLOC(xt, len, int);
+ strcpy (ss1, "");
+
+ calcmean (wmean, vec, len, xtypes, numeg);
+ if (pubmean)
+ {
+ copyarr (wmean, w1, numeg);
+ sortit (w1, isort, numeg);
+ printf ("%s:means\n", sss);
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ printf ("%20s ", eglist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
}
- }
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
+ vlmaxmin (wmean, numeg, &imax, &imin);
+ if (chisqmode)
+ {
+ ylike = anova1 (vec, len, xtypes, numeg);
+ ans = 2.0 * ylike;
}
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
+ else
+ {
+ ans = ftail = anova (vec, len, xtypes, numeg);
}
- ++ncall ;
+ ++ncall;
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
+ if (numeg > 2)
+ {
+ sprintf (ss2, "%s %s ", sss, "overall");
+ publishit (ss2, numeg - 1, ans);
+ printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
+ eglist[imax], wmean[imax]);
}
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ n = 0;
+ x1 = x2 = 0;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ if (k == k1)
+ {
+ w1[n] = vec[i];
+ xt[n] = 0;
+ ++n;
+ ++x1;
+ }
+ if (k == k2)
+ {
+ w1[n] = vec[i];
+ xt[n] = 1;
+ ++n;
+ ++x2;
+ }
+ }
+
+ if (x1 <= 1)
+ continue;
+ if (x2 <= 1)
+ continue;
+
+ ylike = anova1 (w1, n, xt, 2);
+ ychi = 2.0 * ylike;
+ chitot[k1 * numeg + k2] += ychi;
+ if (chisqmode)
+ {
+ ansx = ychi;
+ }
+ else
+ {
+ ansx = ftailx = anova (w1, n, xt, 2);
+ }
+
+ sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
+ publishit (ss2, 1, ansx);
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
}
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
+ }
+ free (w1);
+ free (xt);
+ free (wmean);
+ free (isort);
+ return ans;
}
-double anova(double *vec, int len, int *xtypes, int numeg)
+double
+anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, top, bot, ftail;
+ double *w0, *w1, *popsize, *wmean;
- static int ncall2 = 0 ;
+ static int ncall2 = 0;
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
+ if (numeg >= len)
+ {
+ printf ("*** warning: bad anova popsizes too small\n");
+ return 0.0;
+ }
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
+ /* debug */
+ if (numeg == 2)
+ {
+ ++ncall2;
+ for (i = 0; i < len; ++i)
+ {
+ if (ncall2 < 0)
+ break;
+ k = xtypes[i];
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
+ }
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ vvt (w1, wmean, wmean, numeg);
+ top = vdot (w1, popsize, numeg);
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
+ bot = asum2 (w1, len) / (double) (len - numeg);
+ bot *= (double) (numeg - 1);
+ ftail = rtlf (numeg - 1, len - numeg, top / bot);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ftail ;
+ return ftail;
}
-double anova1(double *vec, int len, int *xtypes, int numeg)
+double
+anova1 (double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, y2, ylike;
+ double *w0, *w1, *popsize, *wmean;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
+ y1 = asum2 (w0, len) / (double) len;
+ y2 = asum2 (w1, len) / (double) len;
+ ylike = 0.5 * ((double) len) * log (y1 / y2);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ylike ;
+ return ylike;
}
-void publishit(char *sss, int df, double chi)
+void
+publishit (char *sss, int df, double chi)
{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
+ double tail;
+ char sshit[4];
+ char ss2[MAXSTR];
+ int i, n;
+ char cblank, cunder;
+ static int ncall = 0;
+
+ ++ncall;
+ cblank = ' ';
+ cunder = '_';
+ n = strlen (sss);
+
+ strcpy (ss2, sss);
+ for (i = 0; i < n; ++i)
+ {
+ if (ss2[i] == cblank)
+ ss2[i] = cunder;
+ }
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
+ if (chisqmode)
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
+ printf ("%40s %6d %9.3f", ss2, df, chi);
+ tail = rtlchsq (df, chi);
+ printf (" %12.6g", tail);
+ }
+ else
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %12s\n", "", "p-value");
+ printf ("%40s ", ss2);
+ tail = chi;
+ printf (" %12.6g", tail);
+ }
+ strcpy (sshit, "");
+ if (tail < pvhit)
+ strcpy (sshit, "***");
+ if (tail < pvjack)
+ strcpy (sshit, "+++");
+ printf (" %s", sshit);
+ printf ("\n");
}
void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
+ double *pp, *npp, val, yy;
+ int *popsize;
+ int i, j, k1, k2;
+
+ if (fstonly)
+ return;
+ ZALLOC(pp, numeg * numeg, double);
+ ZALLOC(npp, numeg * numeg, double);
+ popsize = xpopsize;
+
+ ivzero (popsize, numeg);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k1 = xtypes[i];
+ ++popsize[k1];
+ for (j = i + 1; j < nrows; j++)
+ {
+ k2 = xtypes[j];
+ if (k1 < 0)
+ fatalx ("bug\n");
+ if (k2 < 0)
+ fatalx ("bug\n");
+ if (k1 >= numeg)
+ fatalx ("bug\n");
+ if (k2 >= numeg)
+ fatalx ("bug\n");
+ val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
+ pp[k1 * numeg + k2] += val;
+ pp[k2 * numeg + k1] += val;
+ ++npp[k1 * numeg + k2];
+ ++npp[k2 * numeg + k1];
+ }
+ }
+ vsp (npp, npp, 1.0e-8, numeg * numeg);
+ vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
+ yy = trace (pp, numeg) / (double) numeg;
+ vst (pp, pp, 1.0 / yy, numeg * numeg);
+ printf ("\n## Average divergence between populations:");
+ if (numeg <= 10)
+ {
+ printf ("\n");
+ printf ("%10s", "");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %10s", eglist[k1]);
+ }
+ printf (" %10s", "popsize");
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ printf ("%10s", eglist[k2]);
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ };
+ printf (" %10d", popsize[k2]);
+ printf ("\n");
+ }
+ }
+ else
+ { // numeg >= 10
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ for (k1 = k2; k1 < numeg; ++k1)
+ {
+ printf ("dotp: %10s", eglist[k2]);
+ printf (" %10s", eglist[k1]);
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ printf (" %10d", popsize[k2]);
+ printf (" %10d", popsize[k1]);
+ printf ("\n");
+ }
+ }
+ }
+ printf ("\n");
+ printf ("\n");
+ fflush (stdout);
- free(pp) ;
- free(npp) ;
+ free (pp);
+ free (npp);
}
-void printxcorr(double *X, int nrows, Indiv **indxx)
+void
+printxcorr (double *X, int nrows, Indiv **indxx)
{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
+ int k1, k2, t;
+ double y1, y2, yy, rho;
+ Indiv *ind1, *ind2;
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
+ if (pcorrmode == NO)
+ return;
+ for (k1 = 0; k1 < nrows; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < nrows; ++k2)
+ {
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
+ ind1 = indxx[k1];
+ ind2 = indxx[k2];
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
+ t = strcmp (ind1->egroup, ind2->egroup);
+ if (pcpopsonly && (t != 0))
+ continue;
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
+ y1 = X[k1 * nrows + k1];
+ y2 = X[k2 * nrows + k2];
+ yy = X[k1 * nrows + k2];
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
+ rho = yy / sqrt (y1 * y2 + 1.0e-20);
+ printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
+ ind1->egroup, ind2->egroup, rho);
+ }
}
- }
}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum)
{
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
+ int numld;
+ SNP *cuptnew, *cuptold;
+ int pdiff;
+ double gdiff;
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
+ numld = *pnumld;
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
+ cuptnew = snpmarkers[newsnpnum];
+
+ for (;;)
+ {
+ if (numld == 0)
+ break;
+ cuptold = snpmarkers[ldsnpbuff[0]];
+ pdiff = nnint (cuptnew->physpos - cuptold->physpos);
+ gdiff = cuptnew->genpos - cuptold->genpos;
+ if ((pdiff <= ldposlimit) && (gdiff <= ldlimit))
+ break;
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+
+ if (numld < maxld)
+ {
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+ *pnumld = numld;
+ return;
+ }
- *pnumld = numld ;
- return ;
+ if (maxld == numld)
+ {
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+
+ *pnumld = numld;
+ return;
}
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi)
{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
+ /**
+ gsource: array of (normalized) genotypes
+ rsize rows n long.
+ So row 1 is gsource[0]..gsource[n-1]
+ row 2 gsource[n]...gsource[2*n-1]
+ gtarget n long normalized genotype
+ Routine should return residual (n long)
+
+ return code
+ a) 0 Did nothing
+ b) 1 Ran regression
+ c) 2 Residual set 0
+ */
+
+ if (rsize == 0)
+ {
+ copyarr (gtarget, res, n);
+ return 0;
+ }
// Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
+ double *gsource_pass;
+ ZALLOC(gsource_pass, rsize * n, double);
- int i,ii;
+ int i, ii;
// Compute correlation to previous SNPs
double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
+ int rsize_pass = 0;
+ for (i = 0; i < rsize; i++)
+ {
+ sum = 0;
+ for (ii = 0; ii < n; ii++)
+ {
+ sum += gtarget[ii] * gsource[i * n + ii];
+ }
+ // Normalize by (n-1) and square to get cor^2
+ sum = pow (sum / (2 * (n - 1)), 2);
+ // Check if correlation too high
+ if (sum > r2hi)
+ {
+ // Clean up and exit
+ free (gsource_pass);
+
+ // Residual set to all zero
+ for (ii = 0; ii < n; ii++)
+ res[ii] = 0;
+ return 2;
+ // Check if correlation not too low
+ }
+ else if (sum > r2lo)
+ {
+ // Retain this SNP for the regression
+ for (ii = 0; ii < n; ii++)
+ gsource_pass[rsize_pass * n + ii] = gsource[i * n + ii];
+ rsize_pass++;
+ }
}
- }
// Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ;
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ;
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
+ if (rsize_pass > 0)
+ {
+ double *t_gsource_pass, *regans, *www;
+ ZALLOC(regans, rsize, double);
+ ZALLOC(www, n, double);
+ ZALLOC(t_gsource_pass, rsize * n, double);
+ // Transpose gsource_pass to comply with regressit
+ transpose (t_gsource_pass, gsource_pass, rsize, n);
+
+ regressit (regans, t_gsource_pass, gtarget, n, rsize_pass);
+ mulmat (www, regans, gsource_pass, 1, rsize_pass, n);
+ vvm (res, gtarget, www, n);
+
+ free (regans);
+ free (www);
+ free (t_gsource_pass);
+ free (gsource_pass);
+ return 1;
+ }
+ else
+ {
+ copyarr (gtarget, res, n);
+ free (gsource_pass);
+ return 0;
+ }
+}
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xfst;
- if ( qtmode == YES ) {
- return;
- }
+ if (qtmode == YES)
+ {
+ return;
+ }
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ printf ("number of blocks for moving block jackknife: %d\n", nblocks);
+ if (nblocks <= 1)
+ {
+ return;
+ }
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xfst, numeg*numeg, double);
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ dofstnumx (xfst, fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm, YES);
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
+ free (blstart);
+ free (blsize);
+ free (xfst);
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
+}
+void
+fixwt (SNP **snpm, int nsnp, double val)
+{
+ int k;
+ SNP *cupt;
+
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ cupt->weight = val;
+ }
}
-void fixwt(SNP **snpm, int nsnp, double val)
+
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int k ;
- SNP *cupt ;
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ static int ncall = 0;
+
+ ++ncall;
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
+ if (ncall < 0)
+ {
+ printf ("qq2\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ return 0.0;
+ }
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
-}
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
+ ed = en;
+ ed += h1;
+ ed += h2;
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ *estn = en;
+ *estd = ed;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ free (rawcol);
+ return z + zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+}
- *estn = en ;
- *estd = ed ;
-
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
+{
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ int **ccc;
+ static int ncall = 0;
- free(rawcol) ;
- return z + zz ;
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ZALLOC(rawcol, nrows, int);
-}
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ ivzero (c1, 2);
+ ivzero (c2, 2);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = ccc[i][0];
+ if (ncall < 1000)
+ {
// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
+ }
+
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, ccc[i], 2);
}
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ if (ncall < 0)
+ {
+ printf ("qqq\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 1.1) || (zz < 1.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ ed = en;
+ ed += h1;
+ ed += h2;
- *estn = en ;
- *estd = ed ;
-
+ *estn = en;
+ *estd = ed;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols)
{
// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
+ double *xpt, y, yscal, *snpsc;
+ int i, j, k, kmax, kmin;
+ SNP * cupt;
+ FILE *fff;
+ for (j = 0; j < numeigs; ++j)
+ {
+ xpt = ffvecs + j * ncols;
+ y = asum2 (xpt, ncols);
+ yscal = (double) ncols / y;
+ yscal = sqrt (yscal);
+ vst (xpt, xpt, yscal, ncols);
+ }
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
- if (ncols<=10) break ;
+ ZALLOC(snpsc, ncols, double);
+ vclear (snpsc, -99999, ncols);
+ for (j = 0; j < numeigs; ++j)
+ {
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
+ y = ffvecs[j * ncols + i];
+ snpsc[i] = fabs (y);
+ }
+ for (k = 0; k < 10; ++k)
+ {
+ if (ncols <= 10)
+ break;
// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
+ vlmaxmin (snpsc, ncols, &kmax, &kmin);
+ cupt = xsnplist[kmax];
+ if (snpsc[kmax] < 0)
+ break;
+ printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
+ cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
+ snpsc[kmax] = -1.0;
+ }
+ }
+ free (snpsc);
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
+ if (snpeigname == NULL)
+ return;
+ openit (snpeigname, &fff, "w");
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
+ fprintf (fff, "%20s", cupt->ID);
+ fprintf (fff, " %2d", cupt->chrom);
+ fprintf (fff, " %12d", nnint (cupt->physpos));
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
+ }
+ fprintf (fff, "\n");
+ }
- fclose(fff) ;
+ fclose (fff);
}
@@ -2473,96 +2854,110 @@ writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int
* g[i] set to zero where missing data
* */
-
int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
// returns missings after fill in
{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
+ int j, n, g, t, k, kmax = -1;
+ double y, pmean, yfancy;
+ int *rawcol;
+ int c0, c1, nmiss;
+ double* popnum = NULL;
+ double* popsum = NULL;
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
+ if (usepopsformissing)
+ {
+ ZALLOC(popnum, MAXPOPS+1, double);
+ ZALLOC(popsum, MAXPOPS+1, double);
+ }
+
+ c0 = c1 = 0;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ if (usepopsformissing)
+ {
+ k = xtypes[j];
+ popsum[k] += (double) g;
+ popnum[k] += 1.0;
+ kmax = MAX(kmax, k);
+ }
+ }
+ floatit (xcol, rawcol, nrows);
+ if ((usepopsformissing) && (nmiss > 0))
+ {
+ pmean = asum (popsum, kmax + 1) / asum (popnum, kmax + 1);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g >= 0)
+ continue;
+ k = xtypes[j];
+ if (popnum[k] > 0.5)
+ {
+ y = popsum[k] / popnum[k];
+ xcol[j] = y;
+ continue;
+ }
+ ++nmiss;
+ }
+ }
+ t = fvadjust (xcol, nrows, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, nrows);
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ if (usepopsformissing)
+ {
+ free (popnum);
+ free (popsum);
+ }
+ return nmiss;
}
int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1)
{
// Modified getcolxz() which converts to a 3-bit-per-genotype representation
// compatible with PLINK 1.5's partial sum lookup outer product algorithm.
@@ -2604,49 +2999,57 @@ getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
c0 = c1 = 0;
n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
+ if (n < nrows)
+ {
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ }
+ getrawcol (rawcol, cupt, xindex, nrows);
nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ }
// instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
+ t = fvadjust_binary (c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, 3);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, 3);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ return nmiss;
}
void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows)
{
// slightly better to position at 0-3-6-9-12-16-19... instead of
// 0-3-6-9-12-15-18...
@@ -2655,34 +3058,41 @@ getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
uintptr_t bitfield_or[3];
uint32_t row_idx;
int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
+ bitfield_or[0] = ((uintptr_t) 7) << shift_val;
+ bitfield_or[1] = ((uintptr_t) 2) << shift_val;
+ bitfield_or[2] = ((uintptr_t) 3) << shift_val;
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ cur_geno = *rawcol++;
+ if (cur_geno)
+ {
+ if (cur_geno > 0)
+ {
+ binary_cols[row_idx] |= bitfield_or[(uint32_t) cur_geno];
+ }
+ else
+ {
+ binary_mmask[row_idx] |= bitfield_or[0];
+ }
+ }
}
- }
}
void
-join_threads(pthread_t* threads, uint32_t ctp1)
+join_threads (pthread_t* threads, uint32_t ctp1)
{
- if (!(--ctp1)) {
- return;
- }
+ if (!(--ctp1))
+ {
+ return;
+ }
#if _WIN32
WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
#else
uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
+ for (uii = 0; uii < ctp1; uii++)
+ {
+ pthread_join (threads[uii], NULL);
+ }
#endif
}
@@ -2691,82 +3101,100 @@ int32_t
spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
#else
int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
+spawn_threads (pthread_t* threads, void*
+(*start_routine) (void*),
+ uintptr_t ct)
#endif
{
uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
+ if (ct == 1)
+ {
+ return 0;
}
+ for (ulii = 1; ulii < ct; ulii++)
+ {
+#if _WIN32
+ threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
+ if (!threads[ulii - 1])
+ {
+ join_threads(threads, ulii);
+ return -1;
+ }
#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
+ if (pthread_create (&(threads[ulii - 1]), NULL, start_routine,
+ (void*) ulii))
+ {
+ join_threads (threads, ulii);
+ return -1;
+ }
#endif
- }
+ }
return 0;
}
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
+THREAD_RET_TYPE block_increment_binary(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t cur_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t* binary_cols = g_binary_cols;
+ uintptr_t* binary_mmask = g_binary_mmask;
+ double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
+ double* weights0 = g_weights;
+ double* weights1 = &(g_weights[32768]);
#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
+ double* weights2 = &(g_weights[65536]);
+ double* weights3 = &(g_weights[98304]);
#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
+ uintptr_t* geno_ptr;
+ uintptr_t* mmask_ptr;
+ uintptr_t base_geno;
+ uintptr_t base_mmask;
+ uintptr_t final_geno;
+ uintptr_t indiv_idx2;
+ for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ geno_ptr = binary_cols;
+ base_geno = binary_cols[cur_indiv_idx];
+ mmask_ptr = binary_mmask;
+ base_mmask = binary_mmask[cur_indiv_idx];
+ if (!base_mmask)
+ {
+ // special case: current individual has no missing genotypes in block
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
+ write_ptr++;
+ }
+ }
+ else
+ {
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf)
{
// PLINK 1.5 partial sum lookup algorithm
double increments[40];
@@ -2790,80 +3218,93 @@ domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lowe
#else
for (uii = 0; uii < 10; uii += 5)
#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
+ {
+ dptr = increments;
+ for (ujj = 0; ujj < 5; ujj++)
+ {
+ dptr2 = &(tblock[(uii + ujj) * 3]);
+ *dptr++ = dptr2[0] * dptr2[0];
+ *dptr++ = 0;
+ *dptr++ = dptr2[0] * dptr2[1];
+ *dptr++ = dptr2[0] * dptr2[2];
+ *dptr++ = dptr2[1] * dptr2[1];
+ *dptr++ = dptr2[1] * dptr2[2];
+ *dptr++ = dptr2[2] * dptr2[2];
+ *dptr++ = 0;
+ }
+ dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
+ for (ujj = 0; ujj < 8; ujj++)
+ {
+ partial_incr1 = increments[ujj + 32];
+ for (ukk = 0; ukk < 8; ukk++)
+ {
+ partial_incr2 = partial_incr1 + increments[ukk + 24];
+ for (umm = 0; umm < 8; umm++)
+ {
+ partial_incr3 = partial_incr2 + increments[umm + 16];
+ for (unn = 0; unn < 8; unn++)
+ {
+ partial_incr4 = partial_incr3 + increments[unn + 8];
+ for (uoo = 0; uoo < 8; uoo++)
+ {
+ *dptr++ = partial_incr4 + increments[uoo];
+ }
+ }
+ }
+ }
+ }
}
- }
g_XTX_lower_tri = XTX_lower_tri;
g_weights = partial_sum_lookup_buf;
g_binary_cols = binary_cols;
g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_binary, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_binary ((void*) ulii);
+ join_threads (threads, thread_ct);
}
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
+THREAD_RET_TYPE block_increment_normal(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t start_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t indiv_ct = g_indiv_ct;
+ uint32_t block_size = g_block_size;
+ double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
+ double* write_ptr;
+ double* tblock;
+ double* tblock_read_ptr;
+ double cur_tblock_val;
+ uintptr_t cur_indiv_idx;
+ uintptr_t indiv_idx2;
+ uint32_t bidx;
+ for (bidx = 0; bidx < block_size; bidx++)
+ {
+ write_ptr = write_start_ptr;
+ tblock = &(g_tblock[bidx * indiv_ct]);
+ for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ cur_tblock_val = tblock[cur_indiv_idx];
+ tblock_read_ptr = tblock;
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int block_size,
+ uint32_t indiv_ct)
{
// General case: tblock[] can have an arbitrary number of distinct values, so
// can't use bit hacks.
@@ -2875,364 +3316,405 @@ domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lowe
int ii;
double ycheck;
uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
+ for (ii = 0; ii < block_size; ii++)
+ {
+ ycheck = asum (tblock + ii * indiv_ct, indiv_ct);
+ if (fabs (ycheck) > .00001)
+ fatalx ("bad ycheck\n");
+ }
g_XTX_lower_tri = XTX_lower_tri;
g_tblock = tblock;
g_block_size = block_size;
g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_normal, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_normal ((void*) ulii);
+ join_threads (threads, thread_ct);
}
void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
+ int n;
+ double pmean, yfancy;
+ int *rawcol;
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
+ if (xmean != NULL)
+ {
+ xmean[col] = xfancy[col] = 0.0;
+ }
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
+ if (cupt->ignore)
+ {
+ vzero (xcol, nrows);
+ return;
+ }
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
}
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xinb;
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xinb, numeg, double);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
+ doinbreed (xinb, inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm);
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
+ free (blstart);
+ free (blsize);
+ free (xinb);
}
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len)
// extracted from dotttest ;
{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
+ double *w0, *w1;
+ int *isort;
+ int i, k;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(isort, len, int);
-
- calcmean(w0, vec, len, xtypes, numeg) ;
+ calcmean (w0, vec, len, xtypes, numeg);
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
+ copyarr (w0, w1, numeg);
+ sortit (w1, isort, numeg);
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ elist[i] = eglist[k];
+ wmean[i] = w0[k];
}
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
+ free (w0);
+ free (w1);
+ free (isort);
}
void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
{
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
+ int i, j, k;
+ // Indiv *indx ;
+ static int ncall = 0;
- ++ncall ;
+ ++ncall;
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
+ for (k = 0; k < nrows; ++k)
+ {
+ i = xindex[k];
+ if (i < 0)
+ fatalx ("zzyuk!\n");
+ // indx = indivmarkers[i] ;
// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ azq[j * nrows + k] = acoeffs[j * numindivs + i];
+ }
+ }
}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
+void
+dumpgrmid (char *fname, Indiv **indivmarkers, int *xindex, int numid)
{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
+ FILE *fff;
+ int a, b;
+ Indiv *indx;
+
+ openit (fname, &fff, "w");
+ for (a = 0; a < numid; ++a)
+ {
+ b = xindex[a];
+ if ((b < 0) || (b >= numindivs))
+ fatalx ("(dumpgrmid) bad index\n");
+ indx = indivmarkers[b];
+ fprintf (fff, "%s\t%s\n", "NA", indx->ID);
+ }
+ fclose (fff);
}
void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrmbin (double *XTX, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ double y;
+ char sss[256];
+ char *bb;
+ int wout, numout, fdes, ret = 0;
+ float yfloat;
+
+ if (sizeof(yfloat) != 4)
+ fatalx ("grm binary only supported for 4 byte floats\n");
+
+ sprintf (sss, "%s.N.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
+ numout = nrows * (nrows + 1) / 2;
+ wout = numsnps;
+ bb = (char *) &wout;
+
+ for (a = 0; a < numout; ++a)
+ {
+ ret = write (fdes, bb, 4);
+ }
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ close (fdes);
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ sprintf (sss, "%s.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
+ double y_norm;
+ y_norm = trace (XTX, nrows) / (double) nrows;
+
+ bb = (char *) &yfloat;
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b] / y_norm; // bugfix
+ yfloat = (float) y;
+ ret = write (fdes, bb, 4);
+ }
+ }
+ close (fdes);
}
void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
+ double y;
+ FILE *fff;
+ char sss[256];
+
+ if (grmoutname == NULL)
+ return;
+
+ sprintf (sss, "%s.id", grmoutname);
+ dumpgrmid (sss, indivmarkers, xindex, nrows);
+
+ if (grmbinary)
+ {
+ dumpgrmbin (XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname);
+ return;
+ }
// Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
+ double y_norm_recip;
+ double *d;
+ ZALLOC(d, nrows, double);
+ getdiag (d, XTX, nrows);
+ y_norm_recip = ((double) nrows) / asum (d, nrows);
+ free (d);
+
+ openit (grmoutname, &fff, "w");
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b]; // bugfix: do NOT want to dereference xindex here
+ fprintf (fff, "%d %d ", a + 1, b + 1);
+ fprintf (fff, "%d ", numsnps);
+ fprintf (fff, "%0.6f\n", y * y_norm_recip);
+ }
+ }
+ fclose (fff);
}
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile)
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile)
{
- double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y ;
- double *fxscal, *xpt, val ;
- int i, j, k ;
- Indiv *indx ;
+ double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y;
+ double *fxscal, *xpt, val;
+ int i, j, k;
+ Indiv *indx;
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", eigenvals[j]);
+ }
+ fprintf (ofile, "\n");
- if (easymode) {
+ if (easymode)
+ {
// should be separate routine
- ZALLOC(fvecs, nrows*numeigs, double) ;
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- free(fvecs) ;
- return ;
- }
+ ZALLOC(fvecs, nrows*numeigs, double);
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(xrow, ncols, double) ;
- ZALLOC(bcoeffs, numeigs*numindivs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ free (fvecs);
+ return;
+ }
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(cc, nrows, double);
+ ZALLOC(xrow, ncols, double);
+ ZALLOC(bcoeffs, numeigs*numindivs, double);
+ ZALLOC(fxscal, numeigs, double);
-
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
- for (i=0; i<ncols; i++) {
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- getgval(k, i, &val) ;
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*val ;
- }
+ for (i = 0; i < ncols; i++)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ getgval (k, i, &val);
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * val;
+ }
+ }
}
- }
- for (i=0; i<nrows; i++) {
-
- for (k=0; k<ncols; ++k) {
- getgval(i, k, &val) ;
- xrow[k] = val ;
- }
+ for (i = 0; i < nrows; i++)
+ {
- for (j=0; j<numeigs; j++) {
- xpt = ffvecs+j*ncols ;
- y = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
- }
- }
+ for (k = 0; k < ncols; ++k)
+ {
+ getgval (i, k, &val);
+ xrow[k] = val;
+ }
- vsqrt(fxscal, fxscal, numeigs) ;
- vinvert(fxscal, fxscal, numeigs) ;
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = ffvecs + j * ncols;
+ y = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
+ }
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- for (k=0; k<ncols; ++k) {
- getggval(i, k, &val) ;
- xrow[k] = val ;
- }
+ vsqrt (fxscal, fxscal, numeigs);
+ vinvert (fxscal, fxscal, numeigs);
- for (j=0; j<numeigs; j++) {
- bcoeffs[j*numindivs+i] = y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- }
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ for (k = 0; k < ncols; ++k)
+ {
+ getggval (i, k, &val);
+ xrow[k] = val;
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = bcoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ bcoeffs[j * numindivs + i] = y = fxscal[j]
+ * vdot (xrow, ffvecs + j * ncols, ncols);
+ }
+ }
- writesnpeigs(snpeigname, snpmarkers, ffvecs, numeigs, ncols) ;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = bcoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ writesnpeigs (snpeigname, snpmarkers, ffvecs, numeigs, ncols);
- free(fvecs) ;
- free(ffvecs) ;
- free(cc) ;
- free(xrow) ;
- free(bcoeffs) ;
- free(fxscal) ;
+ free (fvecs);
+ free (ffvecs);
+ free (cc);
+ free (xrow);
+ free (bcoeffs);
+ free (fxscal);
}
diff --git a/src/eigensrc/newpca.c b/src/eigensrc/newpca.c
index c2b925c..742bc51 100644
--- a/src/eigensrc/newpca.c
+++ b/src/eigensrc/newpca.c
@@ -30,94 +30,94 @@
Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
+ */
#define WVERSION "13050"
/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
+ Simple eigenvector analysis
+ Options to look at groups (simple ANOVA)
+ Weights allowed for individuals
+ missing mode
+ dotpops added
+ recompiled with new twtail. Output form at changed
+ Cleaned up twestxx
+ fancynorm mode (divide by sqrt(p*(1-p))
+ poplistname supported. Eigenanalysis just on individuals in population
+ But all individuals figure in eigenvector output
+ New way of computing effective marker size (twl2mode)
+ popdifference implemented
+ ldregression ldlimit (genetic distance in Morgans)
+ nostatslim added
+ dotpop has new format if many groups
+ uses new I/O
+ Supports packmode
+ Alkes style outlier removal added
+ Only half XTX computed
+ xdata (huge array) removed
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
+ fst calculation added
+ popsizelimit added
+ divergence added (not useful?)
-SNPs discarded if no data.
-Phylipfile now supported
+ SNPs discarded if no data.
+ Phylipfile now supported
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
+ Preparations for parallelization made
+ Various fixups for EIGENSTRAT and altnormstyle
-output capability added (like convertf)
+ output capability added (like convertf)
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
+ bug fixed (a last iteration needed for outlier removal)
+ bug fixed (numindivs unlimited)
+ output files fixed up (NULL OK)
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
+ Many Alkes style options added
+ Support for outliername added (outlier info)
+ familyname added (ped files)
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+ bugfix: jackrat dies (outlier removes all of population)
+ bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
+ nrows, ncols output added
+ nrows, ncols set each outlier iteration
+ indivs with no data removed
-writesnpeig added
+ writesnpeig added
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
+ bugfix: popsize of 1 no anova done
+ minallelecnt added
+ chrom: added
+ latest greatest handling of chromosome number added.
+ bad bugfix: numvalidgtypes
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
+ checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
+ pubmean added
-fst on X
-fst std errors now fixed
+ fst on X
+ fst std errors now fixed
-bad bug fixed (outfiles changed indivmarkers) ...
+ bad bug fixed (outfiles changed indivmarkers) ...
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
+ fstdetailsname added
+ fsthiprecision added
+ bug fixed (getrawcolx)
-bad bug fix. xtypes not allocated correctly
+ bad bug fix. xtypes not allocated correctly
-version compatible with Mac
-XTX.dbg commented out
+ version compatible with Mac
+ XTX.dbg commented out
-outliermode added
+ outliermode added
-regmode added
-maxpops parametric. Use easymode if large
+ regmode added
+ maxpops parametric. Use easymode if large
-id2pops added
+ id2pops added
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-bugfix to ldregx (Angela Yu)
-*/
+ Threading added Chris Chang)
+ fastmode (Kevin Galinski)
+ bugfix to ldregx (Angela Yu)
+ */
#if _WIN32
// just in case we try a Windows port in the future
@@ -140,222 +140,285 @@ bugfix to ldregx (Angela Yu)
#define MAXSTR 512
#define MAXPOPS 1000
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *parname = NULL;
+char *twxtabname = NULL;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int fastdim = -1 ;
-int fastiter= -1 ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
+SNP **snpmarkers;
+
+int numsnps, numindivs;
+int numeigs = 10; /// default
+int markerscore = NO;
+int maxpops = 100;
+int seed = 0;
+int chisqmode = NO; // approx p-value better to use F-stat
+int missingmode = NO;
+int shrinkmode = NO;
+int dotpopsmode = YES;
+int noxdata = YES; /* default as pop structure dubious if Males and females */
+int fstonly = NO;
+int pcorrmode = NO;
+int pcpopsonly = YES;
+int nostatslim = 10;
+int znval = -1;
+int popsizelimit = -1;
+int altnormstyle = YES; // affects subtle details in normalization formula
+int minallelecnt = 1;
+int maxmissing = 9999999;
+int lopos = -999999999, hipos = 999999999; // use with xchrom
+
+int packout = -1;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+extern int packmode;
+extern int numchrom;
+extern int fancynorm;
+extern int verbose;
+int ogmode = NO;
+int fsthiprec = NO;
+int inbreed = NO; // for fst
+int easymode = NO;
+int fastmode = NO;
+int fastdim = -1;
+int fastiter = -1;
+int regmode = NO;
+
+int numoutliter = 5, numoutleigs = 10, outliermode = 0;
+double outlthresh = 6.0;
+OUTLINFO **outinfo;
+char *outinfoname = NULL;
+char *fstdetailsname = NULL;
+
+double plo = .001;
+double phi = .999;
+double pvhit = .001;
+double pvjack = 1.0e-6;
+double *chitot;
+int *xpopsize;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *deletesnpoutname = NULL;
+char *poplistname = NULL;
+char *xregionname = NULL; /* physical positions of SNPs to exclude */
+char *outliername = NULL;
+char *phylipname = NULL;
+char *snpeigname = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *omode = "packedancestrymap";
+char *grmoutname = NULL;
+int grmbinary = NO;
+double blgsize = 0.05; // block size in Morgans */
+char *id2pops = NULL;
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+int killr2 = NO;
+int pubmean = YES; // change default
double nhwfilter = -1.0;
int thread_ct_config = 0;
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
+int randomfillin = NO;
+int usepopsformissing = NO; // if YES popmean is used for missing. Overall mean if all missing for pop
-int xchrom = -1 ;
+int xchrom = -1;
// list of outliers
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+int ldregress = 0;
+double ldlimit = 9999.0; /* default is infinity */
+double ldr2lo = 0.01;
+double ldr2hi = 0.95;
+int ldposlimit = 1000 * 1000 * 1000;
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi);
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum);
+
+char *outputname = NULL;
+char *outputvname = NULL;
+char *weightname = NULL;
+FILE *ofile, *ovfile;
+
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+twnorm (double lam, double m, double n);
+double
+rhoinv (double x, double gam);
+
+void
+readcommands (int argc, char **argv);
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+fvadjust (double *rr, int n, double *pmean, double *fancy);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+int
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1);
+int
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1);
+void
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows);
+
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+double
+anova1 (double *vec, int len, int *xtypes, int numeg);
+double
+anova (double *vec, int len, int *xtypes, int numeg);
+void
+publishit (char *sss, int df, double chi);
+
+void
+setmiss (SNP **snpm, int numsnps);
+void
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
+void
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
+void
+printxcorr (double *X, int nrows, Indiv **indxx);
+
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
+void
+addoutersym (double *X, double *v, int n);
+void
+symit (double *X, int n);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
+void
+jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
+void
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf);
+void
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int marker_ct,
+ uint32_t indiv_ct);
+void
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols);
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+void
+fixwt (SNP **snpm, int nsnp, double val);
+void
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex);
+void
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname);
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile) ;
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile);
uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
+triangle_divide (int64_t cur_prod, int32_t modif)
{
// return smallest integer vv for which (vv * (vv + modif)) is no smaller
// than cur_prod, and neither term in the product is negative. (Note the
// lack of a divide by two; cur_prod should also be double its "true" value
// as a result.)
int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
+ if (cur_prod == 0)
+ {
+ if (modif < 0)
+ {
+ return -modif;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ vv = (int64_t) sqrt ((double) cur_prod);
+ while ((vv - 1) * (vv + modif - 1) >= cur_prod)
+ {
+ vv--;
+ }
+ while (vv * (vv + modif) < cur_prod)
+ {
+ vv++;
}
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
return vv;
}
void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
+parallel_bounds (uint32_t ct, int32_t start, uint32_t parallel_idx,
+ uint32_t parallel_tot, int32_t* bound_start_ptr,
+ int32_t* bound_end_ptr)
{
int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
+ int64_t ct_tot = ((int64_t) ct) * (ct + modif);
+ *bound_start_ptr = triangle_divide ((ct_tot * parallel_idx) / parallel_tot,
+ modif);
+ *bound_end_ptr = triangle_divide (
+ (ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
}
// set align to 1 for no alignment
void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
+triangle_fill (uint32_t* target_arr, uint32_t ct, uint32_t pieces,
+ uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start,
+ uint32_t align)
{
int32_t modif = 1 - start * 2;
uint32_t cur_piece = 1;
@@ -365,31 +428,34 @@ triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t paral
int32_t ubound;
uint32_t uii;
uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
+ parallel_bounds (ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
// x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
align *= 2;
align_m1 = align - 1;
target_arr[0] = lbound;
target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
+ cur_prod = ((int64_t) lbound) * (lbound + modif);
+ ct_tr = (((int64_t) ubound) * (ubound + modif) - cur_prod) / pieces;
+ while (cur_piece < pieces)
+ {
+ cur_prod += ct_tr;
+ lbound = triangle_divide (cur_prod, modif);
+ uii = (lbound - ((int32_t) start)) & align_m1;
+ if ((uii) && (uii != align_m1))
+ {
+ lbound = start + ((lbound - ((int32_t) start)) | align_m1);
+ }
+ // lack of this check caused a nasty bug earlier
+ if (((uint32_t) lbound) > ct)
+ {
+ lbound = ct;
+ }
+ target_arr[cur_piece++] = lbound;
+ }
}
void
-symit2(double* XTX, uintptr_t nrows)
+symit2 (double* XTX, uintptr_t nrows)
{
// unpacks LOWER-triangle-only symmetric matrix representation into regular
// square matrix.
@@ -397,39 +463,48 @@ symit2(double* XTX, uintptr_t nrows)
uintptr_t col_idx;
double* read_col;
double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
+ if (nrows < 3)
+ {
+ if (nrows < 2)
+ {
+ return;
+ }
+ // special case, need to avoid overlapping memcpy
+ XTX[3] = XTX[2];
+ XTX[2] = XTX[1];
return;
}
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
+ for (row_idx = nrows - 1; row_idx; row_idx--)
+ {
+ memcpy (&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]),
+ (row_idx + 1) * sizeof(double));
+ }
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ read_col = &(XTX[row_idx]);
+ write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
+ for (col_idx = row_idx + 1; col_idx < nrows; col_idx++)
+ {
+ *write_ptr++ = read_col[col_idx * nrows];
+ }
}
- }
}
void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
+copy_transposed (double* orig_matrix, uintptr_t orig_row_ct,
+ uintptr_t orig_col_ct, double* transposed_matrix)
{
uintptr_t new_row_idx;
uintptr_t new_col_idx;
double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++)
+ {
+ orig_col_ptr = &(orig_matrix[new_row_idx]);
+ for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++)
+ {
+ *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ }
}
- }
}
// make these file scope so multithreading works
@@ -443,2017 +518,2319 @@ static double* g_weights;
static uintptr_t* g_binary_cols;
static uintptr_t* g_binary_mmask;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww, *evals ;
+ char sss[MAXSTR];
+ char **eglist;
+ int numeg;
+ int i, j, k, k1, k2, pos;
+ int *vv;
+ SNP *cupt;
+ Indiv *indx;
+ double y1 = 0, y2, y2l, y, y3;
+
+ int n0, n1, nkill;
+
+ int nindiv = 0;
+ double ychi, tail, tw;
+ int nignore, numrisks = 1;
+ double *xrow, *xpt;
+ SNP **xsnplist;
+ Indiv **xindlist;
+ int *xindex, *xtypes = NULL;
+ int nrows, ncols, m, nused;
+ double *XTX, *cc, *evecs, *ww, *evals;
double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
+ double *lambda, *esize;
+ double zn, zvar;
+ double *fvecs, *fxvecs, *fxscal;
+ double *ffvecs;
+ int weightmode = NO;
+ double ynrows;
+ int t, tt;
+ double *xmean, *xfancy;
+ double *ldvv = NULL, ynumsnps = 0; // for grm
+ int *ldsnpbuff = NULL;
+ int lastldchrom, numld;
+ double *fstans, *fstsd;
+ double *inbans, *inbsd;
+
+ int chrom;
+ int outliter, numoutiter, *badlist, nbad;
+ FILE *outlfile, *phylipfile;
+ double *eigkurt, *eigindkurt;
+ double *wmean;
+ char **elist;
+ double *shrink;
+ double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL;
+ int kk;
+ double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq;
+
+ int xblock;
int blocksize = 1024;
double *tblock = NULL;
int* binary_rawcol = NULL;
uintptr_t* binary_cols = NULL;
uintptr_t* binary_mmask = NULL;
- OUTLINFO *outpt ;
+ OUTLINFO *outpt;
pthread_t threads[MAX_THREADS];
uint32_t thread_ct;
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
+ readcommands (argc, argv);
+ printf ("## smartpca version: %s\n", WVERSION);
+ packmode = YES;
+ setomode (&outputmode, omode);
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
+ if (parname == NULL)
+ return 0;
+ if (xchrom == (numchrom + 1))
+ noxdata = NO;
- if (fastmode) {
- if (fastiter < 0) fastiter = numeigs;
- if (fastdim < 0) fastdim = 2*numeigs;
- }
+ if (fastmode)
+ {
+ if (fastiter < 0)
+ fastiter = numeigs;
+ if (fastdim < 0)
+ fastdim = 2 * numeigs;
+ }
-/**
- if (fastmode) {
+ /**
+ if (fastmode) {
printf("fastmode => easymode\n") ;
easymode = YES ;
- }
-*/
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
-
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
+ }
+ */
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
+ if (usepopsformissing)
+ {
+ printf ("usepopsformissing => easymode\n");
+ easymode = YES;
+ }
- nostatslim = MAX(nostatslim, 3) ;
+ if (deletesnpoutname != NULL)
+ { /* remove because snplog opens in append mode */
+ char buff[256];
+ sprintf (buff, "rm -f %s", deletesnpoutname);
+ system (buff);
+ }
- outlfile = ofile = stdout;
+ if (fstonly)
+ {
+ printf ("fstonly\n");
+ numeigs = 0;
+ numoutliter = 0;
+ numoutiter = 0;
+ outputname = NULL;
+ snpeigname = NULL;
+ }
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
+ if (fancynorm)
+ printf ("norm used\n\n");
+ else
+ printf ("no norm used\n\n");
+ if (regmode)
+ printf ("lsqproject used\n");
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
+ nostatslim = MAX(nostatslim, 3);
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
+ outlfile = ofile = stdout;
- numindivs = getindivs(indivname, &indivmarkers) ;
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
+ if (outliername != NULL)
+ openit (outliername, &outlfile, "w");
+ if (fstdetailsname != NULL)
+ openit (fstdetailsname, &fstdetails, "w");
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
+ if ((ldlimit <= 0) || (ldposlimit <= 0))
+ ldregress = 0;
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+ numindivs = getindivs (indivname, &indivmarkers);
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
+ if (id2pops != NULL)
+ {
+ setid2pops (id2pops, indivmarkers, numindivs);
+ }
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
+ k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
}
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
+ else
+ {
+ setstatus (indivmarkers, numindivs, NULL);
+ ZALLOC(eglist, MAXPOPS, char *);
+ numeg = makeeglist (eglist, maxpops, indivmarkers, numindivs);
}
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
+ for (i = 0; i < numeg; i++)
+ {
+ /* printf("%3d %s\n",i, eglist[i]) ; */
}
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
+
+ nindiv = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == YES)
+ ++nindiv;
}
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ chrom = cupt->chrom;
+ if ((noxdata) && (chrom == (numchrom + 1)))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-X", deletesnpoutname);
+ }
+ if (chrom == 0)
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-0", deletesnpoutname);
+ }
+ if (chrom > (numchrom + 1))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-big", deletesnpoutname);
+ }
}
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
+ for (i = 0; i < numsnps; i++)
{
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
+ cupt = snpmarkers[i];
+ pos = nnint (cupt->physpos);
+ if ((xchrom > 0) && (cupt->chrom != xchrom))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "not-chrom", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos < lopos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "lopos", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos > hipos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "hipos", deletesnpoutname);
+ }
+ if (cupt->ignore)
+ continue;
+ if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
+ {
+ printf ("nodata: %20s\n", cupt->ID);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "nodata", deletesnpoutname);
+ }
}
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
+ if (xregionname)
+ {
+ excluderegions (xregionname, snpmarkers, numsnps, deletesnpoutname);
+ }
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
+ if (nhwfilter > 0)
+ {
+ hwfilter (snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
+ }
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
+ ZALLOC(vv, numindivs, int);
+ numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
+ for (i = 0; i < numindivs; ++i)
+ {
+ if (vv[i] == 0)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = YES;
+ }
+ }
+ free (vv);
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
+ numsnps = rmsnps (snpmarkers, numsnps, deletesnpoutname); // rid ignorable snps
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
+ if (missingmode)
+ {
+ setmiss (snpmarkers, numsnps);
+ fancynorm = NO;
+ }
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
+ if (weightname != NULL)
+ {
+ weightmode = YES;
+ getweights (weightname, snpmarkers, numsnps);
+ }
+ if (ldregress > 0)
+ {
+ ZALLOC(ldvv, ldregress*numindivs, double);
+ ZALLOC(ldsnpbuff, ldregress, int); // index of snps
+ }
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
+ ZALLOC(xindex, numindivs, int);
+ ZALLOC(xindlist, numindivs, Indiv *);
+ ZALLOC(xsnplist, numsnps, SNP *);
+ if (popsizelimit > 0)
+ {
+ setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
+ }
/* Load non-ignored individuals into xindlist,xindex:
* xindex[i] = index into indivmarkers
* xindlist[i] = pointer to Indiv struct */
- ZALLOC(xtypes, numindivs, int) ;
-
-
+ ZALLOC(xtypes, numindivs, int);
/* Load non-ignored SNPs into xsnplist:
* xsnplist[i] = pointer to SNP struct */
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
+ printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);
- if (fastmode) {
+ if (fastmode)
+ {
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
+ setgval (xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols);
// side-effect monomorphic snps -> ignore
- ZALLOC(evals, numeigs, double) ;
- ZALLOC(evecs, numeigs*nrows, double) ;
-
- kjg_fpca(numeigs, fastdim, fastiter,
- evals, evecs);
+ ZALLOC(evals, numeigs, double);
+ ZALLOC(evecs, numeigs*nrows, double);
- printf("##bug: \n") ; printmat(evals, 1, numeigs) ; printmat(evecs, 1, 20) ;
+ kjg_fpca (numeigs, fastdim, fastiter, evals, evecs);
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
+ printf ("##bug: \n");
+ printmat (evals, 1, numeigs);
+ printmat (evecs, 1, 20);
- transpose(evecs, evecs, nrows, numeigs) ;
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
+ }
+ fclose (ovfile);
+ }
- printevecs(xsnplist, indivmarkers, xindlist,
- numindivs, ncols, nrows, numeigs,
- evecs, evals, ofile) ;
+ transpose (evecs, evecs, nrows, numeigs);
+ printevecs (xsnplist, indivmarkers, xindlist, numindivs, ncols, nrows,
+ numeigs, evecs, evals, ofile);
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
+ printf ("end of smartpca(fastmode)\n");
+ return 0;
-}
-
+ }
/* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
+ ZALLOC(xmean, ncols, double);
+ ZALLOC(xfancy, ncols, double);
+
+ ZALLOC(XTX, nrows*nrows, double);
+ ZALLOC(evecs, nrows*nrows, double);
+ if ((!usepopsformissing) && (ldregress == 0))
+ {
+ // should not use lookup table if
+ // - usepopsformissing is set (since each population may have a different
+ // mean), or
+ // - ldregress > 0
#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
+ blocksize = 20;
+ ZALLOC(partial_sum_lookup_buf, 131072, double);
#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
+ blocksize = 10;
+ ZALLOC(partial_sum_lookup_buf, 65536, double);
#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
+ ZALLOC(binary_rawcol, nrows, int);
+ ZALLOC(binary_cols, nrows, uintptr_t);
+ ZALLOC(binary_mmask, nrows, uintptr_t);
+ ZALLOC(tblock, 3 * blocksize, double);
+ }
+ else
+ {
+ ZALLOC(tblock, nrows*blocksize, double);
+ }
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
+ ZALLOC(lambda, nrows, double);
+ ZALLOC(esize, nrows, double);
+ ZALLOC(cc, (nrows > 3)? nrows : 3, double);
+ ZALLOC(ww, nrows, double);
+ ZALLOC(badlist, nrows, int);
- blocksize = MIN(blocksize, ncols) ;
+ blocksize = MIN(blocksize, ncols);
// xfancy is multiplier for column xmean is mean to take off
// badlist is list of rows to delete (outlier removal)
- numoutiter = 1 ;
+ numoutiter = 1;
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
+ if (numoutliter >= 1)
+ {
+ numoutiter = numoutliter + 1;
+ ZALLOC(outinfo, nrows, OUTLINFO *);
+ for (k = 0; k < nrows; k++)
+ {
+ ZALLOC(outinfo[k], 1, OUTLINFO);
+ }
+ /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
+ setoutliermode (outliermode);
+ }
+ else
+ setoutliermode (2);
// try to autodetect number of (virtual) processors, and use that number to
// set the thread count. allow the user to override this in the future
#if _WIN32
SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
+ if (thread_ct_config <= 0)
+ {
+ GetSystemInfo(&sysinfo);
+ thread_ct = sysinfo.dwNumberOfProcessors;
+ }
+ else
+ {
+ thread_ct = thread_ct_config;
+ }
#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
+ if (thread_ct_config <= 0)
+ {
+ i = sysconf (_SC_NPROCESSORS_ONLN);
+ if (i == -1)
+ {
+ thread_ct = 1;
+ }
+ else
+ {
+ thread_ct = i;
+ }
}
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
+ else
+ {
+ thread_ct = thread_ct_config;
}
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
+#endif
+ if (thread_ct > 8)
+ {
+ if (thread_ct > MAX_THREADS)
+ {
+ thread_ct = MAX_THREADS;
+ }
+ else
+ {
+ thread_ct--;
+ }
}
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ if (thread_ct > nrows * 2)
+ {
+ thread_ct = nrows / 2;
+ if (!thread_ct)
+ {
+ thread_ct = 1;
+ }
}
+ printf ("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1) ? "" : "s",
+ (partial_sum_lookup_buf) ? ", and partial sum lookup algorithm" : "");
+ triangle_fill (g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
+ nkill = 0;
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
+ for (outliter = 1; outliter <= numoutiter; ++outliter)
+ {
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
+ if (fstonly)
+ {
+ setidmat (XTX, nrows);
+ vclear (lambda, 1.0, nrows);
+ break;
+ }
+ if (outliter > 1)
+ {
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ }
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
+ vzero (XTX, (nrows * (nrows + 1)) / 2);
+ xblock = 0;
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
+ vzero (xmean, ncols);
+ vclear (xfancy, 1.0, ncols);
- ++xblock ;
- ++nused ;
+ nused = 0;
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
+ }
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
+ numld = 0;
+ lastldchrom = -1;
+ ynumsnps = 0;
+ if (partial_sum_lookup_buf)
+ {
+ for (i = 0; i < nrows; i++)
+ {
+ binary_cols[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ binary_mmask[i] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ vzero (tblock, nrows * blocksize);
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ chrom = cupt->chrom;
+ if (!partial_sum_lookup_buf)
+ {
+ tt = getcolxz (cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy,
+ &n0, &n1);
+ }
+ else
+ {
+ tt = getcolxz_binary1 (binary_rawcol, cc, cupt, xindex, nrows, i,
+ xmean, xfancy, &n0, &n1);
+ }
+
+ t = MIN(n0, n1);
+
+ if ((t < minallelecnt) || (tt > maxmissing) || (tt < 0) || (t == 0))
+ {
+ t = MAX(t, 0);
+ tt = MAX(tt, 0);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "minallelecnt", deletesnpoutname);
+ vzero (cc, nrows);
+ if (nkill < 10)
+ printf (" snp %20s ignored . allelecnt: %5d missing: %5d\n",
+ cupt->ID, t, tt);
+ ++nkill;
+ continue;
+ }
+
+ if (lastldchrom != chrom)
+ numld = 0;
+
+ if (!partial_sum_lookup_buf)
+ {
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, nrows);
+ }
+
+ if (ldregress > 0)
+ {
+
+ t = ldregx (ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi);
+ if (t < 2)
+ {
+ bumpldvv (ldvv, cc, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ ynumsnps += asum2 (ww, nrows) / asum2 (cc, nrows);
+ // don't need to think hard about how cc is normalizes
+ }
+ else
+ {
+ // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
+ bumpldvv (ldvv, ww, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ }
+ copyarr (ww, cc, nrows);
+ }
+ else
+ ++ynumsnps;
+ copyarr (cc, tblock + xblock * nrows, nrows);
+ }
+ else
+ {
+ getcolxz_binary2 (binary_rawcol, binary_cols, binary_mmask,
+ xblock, nrows);
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, 3);
+ }
+ ++ynumsnps;
+ copyarr (cc, &(tblock[xblock * 3]), 3);
+ }
+
+ ++xblock;
+ ++nused;
+
+ /** this is the key code to parallelize */
+ if (xblock == blocksize)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock,
+ nrows, partial_sum_lookup_buf);
+ for (j = 0; j < nrows; j++)
+ {
+ binary_cols[j] = 0;
+ }
+ for (j = 0; j < nrows; j++)
+ {
+ binary_mmask[j] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock,
+ xblock, nrows);
+ vzero (tblock, nrows * blocksize);
+ }
+ xblock = 0;
+ }
+ }
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
+ if (xblock > 0)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock, nrows,
+ partial_sum_lookup_buf);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock, xblock,
+ nrows);
+ }
+ }
+ symit2 (XTX, nrows);
+ printf ("total number of snps killed in pass: %d used: %d\n", nkill,
+ nused);
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
+ if (verbose)
+ {
+ printdiag (XTX, nrows);
+ }
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
+ y = trace (XTX, nrows) / (double) (nrows - 1);
+ if (isnan(y))
+ fatalx ("bad XTX matrix\n");
+ /* printf("trace: %9.3f\n", y) ; */
+ if (y <= 0.0)
+ fatalx ("XTX has zero trace (perhaps no data)\n");
+ vst (XTX, XTX, 1.0 / y, nrows * nrows);
- eigvecs(XTX, lambda, evecs, nrows) ;
+ eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
+ if (outliter > numoutliter)
+ break;
+ // last pass skips outliers
+ numoutleigs = MIN(numoutleigs, nrows - 1);
+ nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
+ outinfo);
+ if (nbad == 0)
+ break;
+ for (i = 0; i < nbad; i++)
+ {
+ j = badlist[i];
+ indx = xindlist[j];
+ outpt = outinfo[j];
+ fprintf (outlfile,
+ "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
+ indx->ID, outliter, outpt->vecno, outpt->score,
+ indx->egroup);
+ indx->ignore = YES;
+ }
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ printf ("number of samples after outlier removal: %d\n", nrows);
+ }
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
+ if (outliername != NULL)
+ fclose (outlfile);
+ dumpgrm (XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname);
+ if (grmoutname != NULL)
+ printf ("grm dumped\n");
- m = numgtz(lambda, nrows) ;
+ m = numgtz (lambda, nrows);
/* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
+ if (m == 0)
+ fatalx ("no data\n");
/* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
+ if (settwxtable (twxtabname) < 0)
+ {
+ printf ("\n## To get Tracy-Widom statistics: recompile smartpca with");
+ printf (" TWTAB correctly specified in Makefile, or\n");
+ printf (" just run twstats (see README file in POPGEN directory)\n");
+ }
else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
+ {
+ /* *** START of code to print Tracy-Widom statistics */
+ printf ("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows,
+ ncols);
+ y = -1.0;
+ printf ("%4s %12s", "#N", "eigenvalue");
+ printf ("%12s", "difference");
+ printf (" %9s %12s", "twstat", "p-value");
+ printf (" %9s", "effect. n");
+ printf ("\n");
+
+ ynrows = (double) nrows;
+
+ for (i = 0; i < m; ++i)
+ {
+ if (fstonly)
+ break;
+ zn = znval;
+ if (zn > 0)
+ zn = MAX(ynrows, zn);
+ tail = dotwcalc (lambda + i, m - i, &tw, &zn, &zvar, nostatslim);
+ esize[i] = zn;
+ printf ("%4d %12.6f", i + 1, lambda[i]);
+ if (i == 0)
+ printf ("%12s", "NA");
+ else
+ printf ("%12.6f", lambda[i] - lambda[i - 1]);
+ if (tail >= 0.0)
+ printf (" %9.3f %12.6g", tw, tail);
+ else
+ printf (" %9s %12s", "NA", "NA");
+ if (zn > 0.0)
+ {
+ printf (" %9.3f", zn);
+ }
+ else
+ {
+ printf (" %9s", "NA");
+ }
+ printf ("\n");
+ }
+ /* END of code to print Tracy-Widom statistics */
}
- /* END of code to print Tracy-Widom statistics */
- }
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
+ numeigs = MIN(numeigs, nrows);
+ numeigs = MIN(numeigs, ncols);
+
+ ZALLOC(shrink, numeigs, double);
+ vclear (shrink, 1.0, numeigs);
+ t = nrows - numeigs;
+ if (t > 0)
+ y1 = asum (lambda + numeigs, t) / (double) t;
+ y = (double) nrows / esize[numeigs];
+ y = MIN(y, 1.0 / y); // gamma
+ for (j = 0; j < numeigs; j++)
+ {
+ if (!shrinkmode)
+ break;
+ if (t <= 0)
+ break;
+ if (esize[j] < 0.1)
+ break;
+ y2 = lambda[j] / y1;
// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
+ y2l = rhoinv (y2, y);
+ if (y2l < 0.0)
+ break;
+ y3 = (y2l - 1.0) / (y2l + y - 1.0);
+ y3 = MIN(y3, 1.0);
+ if (y3 < 0.0)
+ y3 = 1.0;
+ shrink[j] = y3;
+ printf ("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l);
+ }
/* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
/* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
/* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
/* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", lambda[j]);
+ }
+ fprintf (ofile, "\n");
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
+ }
+ fclose (ovfile);
}
- fclose(ovfile) ;
- }
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(fxvecs, nrows*numeigs, double);
+ ZALLOC(fxscal, numeigs, double);
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(xrow, ncols, double);
+ setfvecs (fvecs, evecs, nrows, numeigs);
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ if (easymode)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ if (pubmean)
+ {
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(elist, numeg, char *);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ calcpopmean (wmean, elist, xpt, eglist, numeg, xtypes, nrows);
+ printf ("eig: %d ", j + 1);
+ printf ("min: %s %9.3f ", elist[0], wmean[0]);
+ printf ("max: %s %9.3f ", elist[numeg - 1], wmean[numeg - 1]);
+ printnl ();
+ for (k = 0; k < numeg; ++k)
+ {
+ printf ("%20s ", elist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
+ }
}
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
+ printf ("## easymode set. end of smartpca run\n");
+ return 0;
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * cc[k];
+ }
+ }
}
- }
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
+ ZALLOC(eigkurt, numeigs, double);
+ ZALLOC(eigindkurt, numeigs, double);
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ eigkurt[j] = kurtosis (ffvecs + j * ncols, ncols);
+ eigindkurt[j] = kurtosis (fvecs + j * nrows, nrows);
+ }
- for (i=0; i<nrows; i++) {
+ for (i = 0; i < nrows; i++)
+ {
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
+ loadxdataind (xrow, xsnplist, xindex[i], ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
- for (j=0; j<numeigs; j++) {
+ for (j = 0; j < numeigs; j++)
+ {
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
+ xpt = ffvecs + j * ncols;
+ y = fxvecs[j * nrows + i] = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
+ }
+ }
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j];
+// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
+ fxscal[j] = 1.0 / sqrt (y); // standard
+ }
+ ZALLOC(acoeffs, numindivs*numeigs, double);
+ ZALLOC(bcoeffs, numindivs*numeigs, double);
+ if (partial_sum_lookup_buf)
+ {
+ free (partial_sum_lookup_buf);
+ free (binary_rawcol);
+ free (binary_cols);
+ free (binary_mmask);
+ }
+ free (tblock);
+ if (regmode)
+ {
+ ZALLOC(trow, ncols, double);
+ ZALLOC(rhs, ncols, double);
+ ZALLOC(emat, ncols*numeigs, double);
+ ZALLOC(regans, numeigs, double);
+ /**
+ for (j=0; j<numeigs; ++j) {
+ xpt = ffvecs+j*ncols ;
+ y = asum2(xpt, ncols) ;
+ fxscal[j] = (double) ncols / sqrt(y*y) ;
+ }
+ */
+ }
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ if (!regmode)
+ break;
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ copyarr (xrow, trow, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ kk = 0;
+ for (k = 0; k < ncols; ++k)
+ {
+ if (trow[k] < 0)
+ continue;
+ rhs[kk] = xrow[k];
+ for (j = 0; j < numeigs; j++)
+ {
+ emat[kk * numeigs + j] = fxscal[j] * ffvecs[j * ncols + k];
+ }
+ ++kk;
+ }
+ if (kk <= numeigs)
+ {
+ indx->ignore = YES;
+ printf ("%s ignored (insufficient data\n", indx->ID);
+ continue;
+ }
+ regressit (regans, emat, rhs, kk, numeigs);
+ for (j = 0; j < numeigs; ++j)
+ {
+ acoeffs[j * numindivs + i] = regans[j];
+ }
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j] * vdot (xrow, ffvecs + j * ncols, ncols);
+ if (shrinkmode && (indx->affstatus == YES))
+ y *= shrink[j];
+ bcoeffs[j * numindivs + i] = y;
+ }
+ }
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
+ if (!regmode)
+ {
+ free (acoeffs);
+ acoeffs = bcoeffs;
+ }
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
+ ZALLOC(azq, nrows*numeigs, double);
+ ZALLOC(bzq, nrows*numeigs, double);
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
+ sqz (azq, acoeffs, numeigs, nrows, xindex);
+ sqz (bzq, bcoeffs, numeigs, nrows, xindex);
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ if (!regmode)
+ break;
+ apt = azq + j * nrows;
+ bpt = bzq + j * nrows;
+ y = vdot (apt, bpt, nrows) / vdot (apt, apt, nrows);
+ vst (acoeffs + j * numindivs, acoeffs + j * numindivs, y, numindivs);
+ }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = acoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ if (qtmode)
+ {
+ fprintf (ofile, "%15.6e\n", indx->qval);
+ }
+ else
+ {
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
+ printf ("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs");
+ for (j = 0; j < numeigs; ++j)
+ {
+ y1 = eigkurt[j];
+ y2 = eigindkurt[j];
+ printf ("%12s %4d %9.3f %9.3f\n", "eigenvector", j + 1, y1, y2);
+ }
+// output files
+ settersemode (YES);
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
+ ZALLOC(xpopsize, numeg, int);
+ for (i = 0; i < numeg; i++)
+ {
+ xpopsize[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ ++xpopsize[k];
+ }
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
+ for (i = 0; i < numeg; i++)
+ {
+ printf ("population: %3d %20s %4d", i, eglist[i], xpopsize[i]);
+ if (xpopsize[i] == 0)
+ printf (" ***");
+ printnl ();
+ }
+ if (numeg == 1)
+ dotpopsmode = NO;
-// output files
- settersemode(YES) ;
+ if (dotpopsmode == NO)
+ {
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ printxcorr (XTX, nrows, xindlist);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
+ printf ("##end of smartpca run\n");
+ return 0;
+ }
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
+ ZALLOC(chitot, numeg*numeg, double);
+ dotpops (XTX, eglist, numeg, xtypes, nrows);
+ ZALLOC(fstans, numeg*numeg, double);
+ ZALLOC(fstsd , numeg*numeg, double);
- if (numeg==1) dotpopsmode = NO ;
+ setinbreed (inbreed);
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
+ if (inbreed)
+ {
+ ZALLOC(inbans, numeg, double);
+ ZALLOC(inbsd , numeg, double);
+ doinbxx (inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+ printf ("## inbreeding coeffs: inbreed std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %20s %10.4f %10.4f\n", eglist[k1], inbans[k1], inbsd[k1]);
+ }
+ free (inbans);
+ free (inbsd);
}
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
+ dofstxx (fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
+ if ((phylipname == NULL) && (numeg > 10))
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ if (fsthiprec == NO)
+ {
+ printf (" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ if (fsthiprec == YES)
+ {
+ printf (" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ }
+ }
+ printf ("\n");
+ }
+ if (fstdetailsname != NULL)
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ fprintf (fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1],
+ eglist[k2], fstans[k1 * numeg + k2],
+ fstsd[k1 * numeg + k2]);
+ }
+ }
+ fprintf (fstdetails, "\n");
+ }
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
+ if (phylipname != NULL)
+ {
+ openit (phylipname, &phylipfile, "w");
+ fprintf (phylipfile, "%6d\n", numeg);
+ sss[10] = CNULL;
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ strncpy (sss, eglist[k1], 10);
+ fprintf (phylipfile, "%10s", sss);
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ y1 = fstans[k1 * numeg + k2];
+ y2 = fstans[k2 * numeg + k1];
+ fprintf (phylipfile, "%6.3f", (0.5 * (y1 + y2)));
+ }
+ fprintf (phylipfile, "\n");
+ }
+ fclose (phylipfile);
+ }
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ if ((numeg <= 10) || fstonly)
+ {
+ if (fsthiprec == NO)
+ {
+ printf ("fst *1000:");
+ printnl ();
+ printmatz5 (fstans, eglist, numeg);
+ printnl ();
}
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ if (fsthiprec == YES)
+ {
+ printf ("fst *1000000:");
+ printnl ();
+ printmatz10 (fstans, eglist, numeg);
+ printnl ();
}
- }
}
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
+ printf ("s.dev * 1000000:\n");
+ vst (fstsd, fstsd, 1000.0, numeg * numeg);
+ printmatz5 (fstsd, eglist, numeg);
+ printnl ();
+ fflush (stdout);
+ if (fstonly)
+ {
+ printf ("##end of smartpca run\n");
+ return 0;
}
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
+ vst (fstsd, fstsd, 1.0 / 1000.0, numeg * numeg);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "eigenvector %d", j + 1);
+ y = dottest (sss, evecs + j * nrows, eglist, numeg, xtypes, nrows);
}
- fclose(phylipfile) ;
- }
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
+ printf ("\n## Statistical significance of differences beween populations:\n");
+ printf (
+ " pop1 pop2 chisq p-value |pop1| |pop2|\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ if (fstonly)
+ break;
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ ychi = chitot[k1 * numeg + k2];
+ tail = rtlchsq (numeigs, ychi);
+ printf ("popdifference: %20s %20s %12.3f %12.6g", eglist[k1],
+ eglist[k2], ychi, tail);
+ printf (" %5d", xpopsize[k1]);
+ printf (" %5d", xpopsize[k2]);
+ printf ("\n");
+ }
}
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
+ printf ("\n");
+ for (i = 0; i < ncols; i++)
+ {
+ if (markerscore == NO)
+ break;
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+ sprintf (sss, "%s raw", cupt->ID);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "%s subtract sing vec %d", cupt->ID, j + 1);
+ y = vdot (cc, evecs + j * nrows, nrows);
+ vst (ww, evecs + j * nrows, y, nrows);
+ vvm (cc, cc, ww, nrows);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ }
}
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
-
- printxcorr(XTX, nrows, xindlist) ;
+ printxcorr (XTX, nrows, xindlist);
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- phandle *ph ;
- int t ;
+ int i;
+ phandle *ph;
+ int t;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
+ if (parname == NULL)
+ {
+ fprintf (stderr, "no parameters\n");
+ return;
+ }
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
-
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "fastdim:", &fastdim) ;
- getint(ph, "fastiter:", &fastiter) ;
-
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "snpeigname:", &snpeigname);
+ getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "outputvecs:", &outputname);
+ getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
+ getstring (ph, "outputvals:", &outputvname);
+ getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "outliername:", &outliername);
+ getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
+ getstring (ph, "phylipname:", &phylipname);
+ getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
+ getstring (ph, "weightname:", &weightname);
+ getstring (ph, "fstdetailsname:", &fstdetailsname);
+ getstring (ph, "deletsnpoutname:", &deletesnpoutname);
+ getint (ph, "numeigs:", &numeigs);
+ getint (ph, "maxpops:", &maxpops);
+ maxpops = MIN(maxpops, MAXPOPS);
+ getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
+ getint (ph, "markerscore:", &markerscore);
+ getint (ph, "chisqmode:", &chisqmode);
+ getint (ph, "missingmode:", &missingmode);
+ getint (ph, "shrinkmode:", &shrinkmode);
+ getint (ph, "fancynorm:", &fancynorm);
+ getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
+ getint (ph, "dotpopsmode:", &dotpopsmode);
+ getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
+ getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
+ getint (ph, "altnormstyle:", &altnormstyle);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "popgenmode:", &altnormstyle);
+ getint (ph, "noxdata:", &noxdata);
+ getint (ph, "inbreed:", &inbreed);
+ getint (ph, "easymode:", &easymode);
+
+ getint (ph, "fastmode:", &fastmode);
+ getint (ph, "fastdim:", &fastdim);
+ getint (ph, "fastiter:", &fastiter);
+
+ getint (ph, "usepopsformissing:", &usepopsformissing);
+ getint (ph, "regmode:", ®mode);
+ getint (ph, "lsqproject:", ®mode);
+
+ t = -1;
+ getint (ph, "xdata:", &t);
+ if (t >= 0)
+ noxdata = 1 - t;
+ getint (ph, "nostatslim:", &nostatslim);
+ getint (ph, "popsizelimit:", &popsizelimit);
+ getint (ph, "minallelecnt:", &minallelecnt);
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "maxmissing:", &maxmissing);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "pubmean:", &pubmean);
+ getint (ph, "fstonly:", &fstonly);
+ getint (ph, "fsthiprecision:", &fsthiprec);
+
+ getint (ph, "ldregress:", &ldregress);
+ getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
+ getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
+ getint (ph, "ldposlimit:", &ldposlimit); /* bases */
+ getdbl (ph, "ldr2lo:", &ldr2lo);
+ getdbl (ph, "ldr2hi:", &ldr2hi);
+ getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
+ getint (ph, "minleneig:", &nostatslim);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "familynames:", &familynames);
+ getint (ph, "qtmode:", &qtmode);
+
+ getint (ph, "numoutliter:", &numoutliter);
+ getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
+ getint (ph, "numoutleigs", &numoutleigs);
+ getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
+ getdbl (ph, "outlthresh:", &outlthresh);
+ getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
+ getint (ph, "outliermode:", &outliermode); /* test distribution with sample removed. Makes sense for small samples */
+ getdbl (ph, "blgsize:", &blgsize);
+
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getint (ph, "outputgroup:", &ogmode);
+ getstring (ph, "grmoutname:", &grmoutname);
+ getint (ph, "grmbinary:", &grmbinary);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getstring (ph, "twxtabname:", &twxtabname);
+ getstring (ph, "id2pops:", &id2pops);
+
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+ getint (ph, "killr2:", &killr2);
+
+ getint (ph, "numchrom:", &numchrom);
+ getstring (ph, "xregionname:", &xregionname);
+ getdbl (ph, "hwfilter:", &nhwfilter);
+
+ getint (ph, "numthreads:", &thread_ct_config);
+
+ printf ("### THE INPUT PARAMETERS\n");
+ printf ("##PARAMETER NAME: VALUE\n");
+ writepars (ph);
}
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
+int
+fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean force missing to zero */
/* set up fancy norming */
{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
+ double p, ynum, ysum, y, ymean, yfancy = 1.0;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ {
+ return -999;
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ if (fancynorm)
+ {
+ p = 0.5 * ymean; // autosomes
+ if (altnormstyle == NO)
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ yfancy = 1.0 / sqrt (y);
+ }
+ if (fancy != NULL)
+ *fancy = yfancy;
+ return nmiss;
}
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
+int
+fvadjust_binary (int c0, int c1, int nmiss, int n, double* cc, double* pmean,
+ double* fancy)
{
double p, ynum, ysum, y, ymean, yfancy = 1.0;
- if (n == nmiss) {
- return -999;
- }
+ if (n == nmiss)
+ {
+ return -999;
+ }
ynum = n - nmiss;
ysum = c0;
ymean = ysum / ynum;
cc[0] = -ymean;
cc[1] = 1.0 - ymean;
cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
+ if (fancynorm)
+ {
+ p = 0.5 * ymean;
+ if (altnormstyle == NO)
+ {
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ }
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ {
+ yfancy = 1.0 / sqrt (y);
+ }
+ }
+ if (pmean)
+ {
+ *pmean = ymean;
}
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
+ if (fancy)
+ {
+ *fancy = yfancy;
}
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
return nmiss;
}
double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0
// perhaps should rewrite to put xa1 etc in arrays
{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ double *w1;
+ int *xt;
+ int i, k1, k2, k, n, x1, x2;
+ double ylike;
+ double ychi;
+ double *wmean;
+ int imax, imin, *isort;
+ static int ncall = 0;
+
+ char ss1[MAXSTR];
+ char ss2[MAXSTR];
+ double ans, ftail, ftailx, ansx;
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(w1, len + numeg, double);
+ ZALLOC(isort, numeg, int);
+ ZALLOC(xt, len, int);
+ strcpy (ss1, "");
+
+ calcmean (wmean, vec, len, xtypes, numeg);
+ if (pubmean)
+ {
+ copyarr (wmean, w1, numeg);
+ sortit (w1, isort, numeg);
+ printf ("%s:means\n", sss);
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ printf ("%20s ", eglist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
}
- }
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
+ vlmaxmin (wmean, numeg, &imax, &imin);
+ if (chisqmode)
+ {
+ ylike = anova1 (vec, len, xtypes, numeg);
+ ans = 2.0 * ylike;
}
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
+ else
+ {
+ ans = ftail = anova (vec, len, xtypes, numeg);
}
- ++ncall ;
+ ++ncall;
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
+ if (numeg > 2)
+ {
+ sprintf (ss2, "%s %s ", sss, "overall");
+ publishit (ss2, numeg - 1, ans);
+ printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
+ eglist[imax], wmean[imax]);
}
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ n = 0;
+ x1 = x2 = 0;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ if (k == k1)
+ {
+ w1[n] = vec[i];
+ xt[n] = 0;
+ ++n;
+ ++x1;
+ }
+ if (k == k2)
+ {
+ w1[n] = vec[i];
+ xt[n] = 1;
+ ++n;
+ ++x2;
+ }
+ }
+
+ if (x1 <= 1)
+ continue;
+ if (x2 <= 1)
+ continue;
+
+ ylike = anova1 (w1, n, xt, 2);
+ ychi = 2.0 * ylike;
+ chitot[k1 * numeg + k2] += ychi;
+ if (chisqmode)
+ {
+ ansx = ychi;
+ }
+ else
+ {
+ ansx = ftailx = anova (w1, n, xt, 2);
+ }
+
+ sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
+ publishit (ss2, 1, ansx);
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
}
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
+ }
+ free (w1);
+ free (xt);
+ free (wmean);
+ free (isort);
+ return ans;
}
-double anova(double *vec, int len, int *xtypes, int numeg)
+double
+anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, top, bot, ftail;
+ double *w0, *w1, *popsize, *wmean;
- static int ncall2 = 0 ;
+ static int ncall2 = 0;
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
+ if (numeg >= len)
+ {
+ printf ("*** warning: bad anova popsizes too small\n");
+ return 0.0;
+ }
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
+ /* debug */
+ if (numeg == 2)
+ {
+ ++ncall2;
+ for (i = 0; i < len; ++i)
+ {
+ if (ncall2 < 0)
+ break;
+ k = xtypes[i];
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
+ }
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ vvt (w1, wmean, wmean, numeg);
+ top = vdot (w1, popsize, numeg);
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
+ bot = asum2 (w1, len) / (double) (len - numeg);
+ bot *= (double) (numeg - 1);
+ ftail = rtlf (numeg - 1, len - numeg, top / bot);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ftail ;
+ return ftail;
}
-double anova1(double *vec, int len, int *xtypes, int numeg)
+double
+anova1 (double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, y2, ylike;
+ double *w0, *w1, *popsize, *wmean;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
+ y1 = asum2 (w0, len) / (double) len;
+ y2 = asum2 (w1, len) / (double) len;
+ ylike = 0.5 * ((double) len) * log (y1 / y2);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ylike ;
+ return ylike;
}
-void publishit(char *sss, int df, double chi)
+void
+publishit (char *sss, int df, double chi)
{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
+ double tail;
+ char sshit[4];
+ char ss2[MAXSTR];
+ int i, n;
+ char cblank, cunder;
+ static int ncall = 0;
+
+ ++ncall;
+ cblank = ' ';
+ cunder = '_';
+ n = strlen (sss);
+
+ strcpy (ss2, sss);
+ for (i = 0; i < n; ++i)
+ {
+ if (ss2[i] == cblank)
+ ss2[i] = cunder;
+ }
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
+ if (chisqmode)
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
+ printf ("%40s %6d %9.3f", ss2, df, chi);
+ tail = rtlchsq (df, chi);
+ printf (" %12.6g", tail);
+ }
+ else
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %12s\n", "", "p-value");
+ printf ("%40s ", ss2);
+ tail = chi;
+ printf (" %12.6g", tail);
+ }
+ strcpy (sshit, "");
+ if (tail < pvhit)
+ strcpy (sshit, "***");
+ if (tail < pvjack)
+ strcpy (sshit, "+++");
+ printf (" %s", sshit);
+ printf ("\n");
}
void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
+ double *pp, *npp, val, yy;
+ int *popsize;
+ int i, j, k1, k2;
+
+ if (fstonly)
+ return;
+ ZALLOC(pp, numeg * numeg, double);
+ ZALLOC(npp, numeg * numeg, double);
+ popsize = xpopsize;
+
+ ivzero (popsize, numeg);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k1 = xtypes[i];
+ ++popsize[k1];
+ for (j = i + 1; j < nrows; j++)
+ {
+ k2 = xtypes[j];
+ if (k1 < 0)
+ fatalx ("bug\n");
+ if (k2 < 0)
+ fatalx ("bug\n");
+ if (k1 >= numeg)
+ fatalx ("bug\n");
+ if (k2 >= numeg)
+ fatalx ("bug\n");
+ val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
+ pp[k1 * numeg + k2] += val;
+ pp[k2 * numeg + k1] += val;
+ ++npp[k1 * numeg + k2];
+ ++npp[k2 * numeg + k1];
+ }
+ }
+ vsp (npp, npp, 1.0e-8, numeg * numeg);
+ vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
+ yy = trace (pp, numeg) / (double) numeg;
+ vst (pp, pp, 1.0 / yy, numeg * numeg);
+ printf ("\n## Average divergence between populations:");
+ if (numeg <= 10)
+ {
+ printf ("\n");
+ printf ("%10s", "");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %10s", eglist[k1]);
+ }
+ printf (" %10s", "popsize");
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ printf ("%10s", eglist[k2]);
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ };
+ printf (" %10d", popsize[k2]);
+ printf ("\n");
+ }
+ }
+ else
+ { // numeg >= 10
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ for (k1 = k2; k1 < numeg; ++k1)
+ {
+ printf ("dotp: %10s", eglist[k2]);
+ printf (" %10s", eglist[k1]);
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ printf (" %10d", popsize[k2]);
+ printf (" %10d", popsize[k1]);
+ printf ("\n");
+ }
+ }
+ }
+ printf ("\n");
+ printf ("\n");
+ fflush (stdout);
- free(pp) ;
- free(npp) ;
+ free (pp);
+ free (npp);
}
-void printxcorr(double *X, int nrows, Indiv **indxx)
+void
+printxcorr (double *X, int nrows, Indiv **indxx)
{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
+ int k1, k2, t;
+ double y1, y2, yy, rho;
+ Indiv *ind1, *ind2;
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
+ if (pcorrmode == NO)
+ return;
+ for (k1 = 0; k1 < nrows; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < nrows; ++k2)
+ {
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
+ ind1 = indxx[k1];
+ ind2 = indxx[k2];
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
+ t = strcmp (ind1->egroup, ind2->egroup);
+ if (pcpopsonly && (t != 0))
+ continue;
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
+ y1 = X[k1 * nrows + k1];
+ y2 = X[k2 * nrows + k2];
+ yy = X[k1 * nrows + k2];
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
+ rho = yy / sqrt (y1 * y2 + 1.0e-20);
+ printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
+ ind1->egroup, ind2->egroup, rho);
+ }
}
- }
}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum)
{
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
+ int numld;
+ SNP *cuptnew, *cuptold;
+ int pdiff;
+ double gdiff;
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
+ numld = *pnumld;
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
+ cuptnew = snpmarkers[newsnpnum];
- *pnumld = numld ;
- return ;
+ for (;;)
+ {
+ if (numld == 0)
+ break;
+ cuptold = snpmarkers[ldsnpbuff[0]];
+ pdiff = nnint (cuptnew->physpos - cuptold->physpos);
+ gdiff = cuptnew->genpos - cuptold->genpos;
+ if ((pdiff <= ldposlimit) && (gdiff <= ldlimit))
+ break;
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+
+ if (numld < maxld)
+ {
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+ *pnumld = numld;
+ return;
+ }
+
+ if (maxld == numld)
+ {
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+
+ *pnumld = numld;
+ return;
}
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi)
{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
+ /**
+ gsource: array of (normalized) genotypes
+ rsize rows n long.
+ So row 1 is gsource[0]..gsource[n-1]
+ row 2 gsource[n]...gsource[2*n-1]
+ gtarget n long normalized genotype
+ Routine should return residual (n long)
+
+ return code
+ a) 0 Did nothing
+ b) 1 Ran regression
+ c) 2 Residual set 0
+ */
+
+ if (rsize == 0)
+ {
+ copyarr (gtarget, res, n);
+ return 0;
+ }
// Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
+ double *gsource_pass;
+ ZALLOC(gsource_pass, rsize * n, double);
- int i,ii;
+ int i, ii;
// Compute correlation to previous SNPs
double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
+ int rsize_pass = 0;
+ for (i = 0; i < rsize; i++)
+ {
+ sum = 0;
+ for (ii = 0; ii < n; ii++)
+ {
+ sum += gtarget[ii] * gsource[i * n + ii];
+ }
+ // Normalize by (n-1) and square to get cor^2
+ sum = pow (sum / (2 * (n - 1)), 2);
+ // Check if correlation too high
+ if (sum > r2hi)
+ {
+ // Clean up and exit
+ free (gsource_pass);
+
+ // Residual set to all zero
+ for (ii = 0; ii < n; ii++)
+ res[ii] = 0;
+ return 2;
+ // Check if correlation not too low
+ }
+ else if (sum > r2lo)
+ {
+ // Retain this SNP for the regression
+ for (ii = 0; ii < n; ii++)
+ gsource_pass[rsize_pass * n + ii] = gsource[i * n + ii];
+ rsize_pass++;
+ }
}
- }
// Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- // EIG5 BUG:
- // transpose(t_gsource_pass,gsource_pass,rsize,n);
- // BUG FIX:
- transpose(t_gsource_pass,gsource_pass,rsize_pass,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ; //run regression
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ; //multiply regans and gsource_pass
-
-/* start of bugfix by Angela Yu
- double *t_gsource_pass_fm;
- ZALLOC(t_gsource_pass_fm, rsize_pass*n, double);
- int fm, fma;
- for(fm = 0; fm < n; fm++){
- for(fma = 0; fma < rsize_pass; fma++){
- t_gsource_pass_fm[fm*rsize_pass+fma] = t_gsource_pass[fm*rsize+fma];
- }
- }
-
- double *gsource_pass_fm;
- ZALLOC(gsource_pass_fm, n*rsize_pass, double);
- for(fm = 0; fm < rsize_pass; fm++){
- for(fma = 0; fma < n; fma++){
- gsource_pass_fm[fm*n+fma] = gsource_pass[fm*n+fma];
- }
- }
-
- regressit(regans, t_gsource_pass_fm, gtarget, n, rsize_pass) ; //run regression
- mulmat(www, regans, gsource_pass_fm, 1, rsize_pass, n) ; //multiply regans and gsource_pass
-
- free(t_gsource_pass_fm);
- free(gsource_pass_fm);
- /* End of bugfix */
-
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
+ if (rsize_pass > 0)
+ {
+ double *t_gsource_pass, *regans, *www;
+ ZALLOC(regans, rsize, double);
+ ZALLOC(www, n, double);
+ ZALLOC(t_gsource_pass, rsize * n, double);
+
+ // Transpose gsource_pass to comply with regressit
+ // EIG5 BUG:
+ // transpose(t_gsource_pass,gsource_pass,rsize,n);
+ // BUG FIX:
+ transpose (t_gsource_pass, gsource_pass, rsize_pass, n);
+
+ regressit (regans, t_gsource_pass, gtarget, n, rsize_pass); //run regression
+ mulmat (www, regans, gsource_pass, 1, rsize_pass, n); //multiply regans and gsource_pass
+
+ /* start of bugfix by Angela Yu
+ double *t_gsource_pass_fm;
+ ZALLOC(t_gsource_pass_fm, rsize_pass*n, double);
+ int fm, fma;
+ for(fm = 0; fm < n; fm++){
+ for(fma = 0; fma < rsize_pass; fma++){
+ t_gsource_pass_fm[fm*rsize_pass+fma] = t_gsource_pass[fm*rsize+fma];
+ }
+ }
+ double *gsource_pass_fm;
+ ZALLOC(gsource_pass_fm, n*rsize_pass, double);
+ for(fm = 0; fm < rsize_pass; fm++){
+ for(fma = 0; fma < n; fma++){
+ gsource_pass_fm[fm*n+fma] = gsource_pass[fm*n+fma];
+ }
+ }
+
+ regressit(regans, t_gsource_pass_fm, gtarget, n, rsize_pass) ; //run regression
+ mulmat(www, regans, gsource_pass_fm, 1, rsize_pass, n) ; //multiply regans and gsource_pass
+
+ free(t_gsource_pass_fm);
+ free(gsource_pass_fm);
+ /* End of bugfix */
+
+ vvm (res, gtarget, www, n);
+
+ free (regans);
+ free (www);
+ free (t_gsource_pass);
+ free (gsource_pass);
+ return 1;
+ }
+ else
+ {
+ copyarr (gtarget, res, n);
+ free (gsource_pass);
+ return 0;
+ }
+}
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xfst;
- if ( qtmode == YES ) {
- return;
- }
+ if (qtmode == YES)
+ {
+ return;
+ }
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ printf ("number of blocks for moving block jackknife: %d\n", nblocks);
+ if (nblocks <= 1)
+ {
+ return;
+ }
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xfst, numeg*numeg, double);
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ dofstnumx (xfst, fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm, YES);
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
+ free (blstart);
+ free (blsize);
+ free (xfst);
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
+}
+void
+fixwt (SNP **snpm, int nsnp, double val)
+{
+ int k;
+ SNP *cupt;
+
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ cupt->weight = val;
+ }
}
-void fixwt(SNP **snpm, int nsnp, double val)
+
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int k ;
- SNP *cupt ;
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ static int ncall = 0;
+
+ ++ncall;
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
+ if (ncall < 0)
+ {
+ printf ("qq2\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ return 0.0;
+ }
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
-}
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
+ ed = en;
+ ed += h1;
+ ed += h2;
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ *estn = en;
+ *estd = ed;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ free (rawcol);
+ return z + zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+}
- *estn = en ;
- *estd = ed ;
-
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
+{
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ int **ccc;
+ static int ncall = 0;
- free(rawcol) ;
- return z + zz ;
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ZALLOC(rawcol, nrows, int);
-}
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ ivzero (c1, 2);
+ ivzero (c2, 2);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = ccc[i][0];
+ if (ncall < 1000)
+ {
// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
+ }
+
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, ccc[i], 2);
}
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ if (ncall < 0)
+ {
+ printf ("qqq\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 1.1) || (zz < 1.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ ed = en;
+ ed += h1;
+ ed += h2;
- *estn = en ;
- *estd = ed ;
-
+ *estn = en;
+ *estd = ed;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols)
{
// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
+ double *xpt, y, yscal, *snpsc;
+ int i, j, k, kmax, kmin;
+ SNP * cupt;
+ FILE *fff;
+ for (j = 0; j < numeigs; ++j)
+ {
+ xpt = ffvecs + j * ncols;
+ y = asum2 (xpt, ncols);
+ yscal = (double) ncols / y;
+ yscal = sqrt (yscal);
+ vst (xpt, xpt, yscal, ncols);
+ }
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
- if (ncols<=10) break ;
+ ZALLOC(snpsc, ncols, double);
+ vclear (snpsc, -99999, ncols);
+ for (j = 0; j < numeigs; ++j)
+ {
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
+ y = ffvecs[j * ncols + i];
+ snpsc[i] = fabs (y);
+ }
+ for (k = 0; k < 10; ++k)
+ {
+ if (ncols <= 10)
+ break;
// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
+ vlmaxmin (snpsc, ncols, &kmax, &kmin);
+ cupt = xsnplist[kmax];
+ if (snpsc[kmax] < 0)
+ break;
+ printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
+ cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
+ snpsc[kmax] = -1.0;
+ }
+ }
+ free (snpsc);
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
+ if (snpeigname == NULL)
+ return;
+ openit (snpeigname, &fff, "w");
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
+ fprintf (fff, "%20s", cupt->ID);
+ fprintf (fff, " %2d", cupt->chrom);
+ fprintf (fff, " %12d", nnint (cupt->physpos));
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
+ }
+ fprintf (fff, "\n");
+ }
- fclose(fff) ;
+ fclose (fff);
}
@@ -2478,96 +2855,110 @@ writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int
* g[i] set to zero where missing data
* */
-
int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
// returns missings after fill in
{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
+ int j, n, g, t, k, kmax = -1;
+ double y, pmean, yfancy;
+ int *rawcol;
+ int c0, c1, nmiss;
+ double* popnum = NULL;
+ double* popsum = NULL;
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
+ if (usepopsformissing)
+ {
+ ZALLOC(popnum, MAXPOPS+1, double);
+ ZALLOC(popsum, MAXPOPS+1, double);
+ }
+
+ c0 = c1 = 0;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ if (usepopsformissing)
+ {
+ k = xtypes[j];
+ popsum[k] += (double) g;
+ popnum[k] += 1.0;
+ kmax = MAX(kmax, k);
+ }
+ }
+ floatit (xcol, rawcol, nrows);
+ if ((usepopsformissing) && (nmiss > 0))
+ {
+ pmean = asum (popsum, kmax + 1) / asum (popnum, kmax + 1);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g >= 0)
+ continue;
+ k = xtypes[j];
+ if (popnum[k] > 0.5)
+ {
+ y = popsum[k] / popnum[k];
+ xcol[j] = y;
+ continue;
+ }
+ ++nmiss;
+ }
+ }
+ t = fvadjust (xcol, nrows, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, nrows);
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ if (usepopsformissing)
+ {
+ free (popnum);
+ free (popsum);
+ }
+ return nmiss;
}
int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1)
{
// Modified getcolxz() which converts to a 3-bit-per-genotype representation
// compatible with PLINK 1.5's partial sum lookup outer product algorithm.
@@ -2609,49 +3000,57 @@ getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
c0 = c1 = 0;
n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
+ if (n < nrows)
+ {
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ }
+ getrawcol (rawcol, cupt, xindex, nrows);
nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ }
// instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
+ t = fvadjust_binary (c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, 3);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, 3);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ return nmiss;
}
void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows)
{
// slightly better to position at 0-3-6-9-12-16-19... instead of
// 0-3-6-9-12-15-18...
@@ -2660,34 +3059,41 @@ getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
uintptr_t bitfield_or[3];
uint32_t row_idx;
int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
+ bitfield_or[0] = ((uintptr_t) 7) << shift_val;
+ bitfield_or[1] = ((uintptr_t) 2) << shift_val;
+ bitfield_or[2] = ((uintptr_t) 3) << shift_val;
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ cur_geno = *rawcol++;
+ if (cur_geno)
+ {
+ if (cur_geno > 0)
+ {
+ binary_cols[row_idx] |= bitfield_or[(uint32_t) cur_geno];
+ }
+ else
+ {
+ binary_mmask[row_idx] |= bitfield_or[0];
+ }
+ }
}
- }
}
void
-join_threads(pthread_t* threads, uint32_t ctp1)
+join_threads (pthread_t* threads, uint32_t ctp1)
{
- if (!(--ctp1)) {
- return;
- }
+ if (!(--ctp1))
+ {
+ return;
+ }
#if _WIN32
WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
#else
uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
+ for (uii = 0; uii < ctp1; uii++)
+ {
+ pthread_join (threads[uii], NULL);
+ }
#endif
}
@@ -2696,82 +3102,100 @@ int32_t
spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
#else
int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
+spawn_threads (pthread_t* threads, void*
+(*start_routine) (void*),
+ uintptr_t ct)
#endif
{
uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
+ if (ct == 1)
+ {
+ return 0;
}
+ for (ulii = 1; ulii < ct; ulii++)
+ {
+#if _WIN32
+ threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
+ if (!threads[ulii - 1])
+ {
+ join_threads(threads, ulii);
+ return -1;
+ }
#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
+ if (pthread_create (&(threads[ulii - 1]), NULL, start_routine,
+ (void*) ulii))
+ {
+ join_threads (threads, ulii);
+ return -1;
+ }
#endif
- }
+ }
return 0;
}
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
+THREAD_RET_TYPE block_increment_binary(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t cur_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t* binary_cols = g_binary_cols;
+ uintptr_t* binary_mmask = g_binary_mmask;
+ double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
+ double* weights0 = g_weights;
+ double* weights1 = &(g_weights[32768]);
#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
+ double* weights2 = &(g_weights[65536]);
+ double* weights3 = &(g_weights[98304]);
#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
+ uintptr_t* geno_ptr;
+ uintptr_t* mmask_ptr;
+ uintptr_t base_geno;
+ uintptr_t base_mmask;
+ uintptr_t final_geno;
+ uintptr_t indiv_idx2;
+ for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ geno_ptr = binary_cols;
+ base_geno = binary_cols[cur_indiv_idx];
+ mmask_ptr = binary_mmask;
+ base_mmask = binary_mmask[cur_indiv_idx];
+ if (!base_mmask)
+ {
+ // special case: current individual has no missing genotypes in block
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
+ write_ptr++;
+ }
+ }
+ else
+ {
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf)
{
// PLINK 1.5 partial sum lookup algorithm
double increments[40];
@@ -2795,80 +3219,93 @@ domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lowe
#else
for (uii = 0; uii < 10; uii += 5)
#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
+ {
+ dptr = increments;
+ for (ujj = 0; ujj < 5; ujj++)
+ {
+ dptr2 = &(tblock[(uii + ujj) * 3]);
+ *dptr++ = dptr2[0] * dptr2[0];
+ *dptr++ = 0;
+ *dptr++ = dptr2[0] * dptr2[1];
+ *dptr++ = dptr2[0] * dptr2[2];
+ *dptr++ = dptr2[1] * dptr2[1];
+ *dptr++ = dptr2[1] * dptr2[2];
+ *dptr++ = dptr2[2] * dptr2[2];
+ *dptr++ = 0;
+ }
+ dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
+ for (ujj = 0; ujj < 8; ujj++)
+ {
+ partial_incr1 = increments[ujj + 32];
+ for (ukk = 0; ukk < 8; ukk++)
+ {
+ partial_incr2 = partial_incr1 + increments[ukk + 24];
+ for (umm = 0; umm < 8; umm++)
+ {
+ partial_incr3 = partial_incr2 + increments[umm + 16];
+ for (unn = 0; unn < 8; unn++)
+ {
+ partial_incr4 = partial_incr3 + increments[unn + 8];
+ for (uoo = 0; uoo < 8; uoo++)
+ {
+ *dptr++ = partial_incr4 + increments[uoo];
+ }
+ }
+ }
+ }
+ }
}
- }
g_XTX_lower_tri = XTX_lower_tri;
g_weights = partial_sum_lookup_buf;
g_binary_cols = binary_cols;
g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_binary, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_binary ((void*) ulii);
+ join_threads (threads, thread_ct);
}
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
+THREAD_RET_TYPE block_increment_normal(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t start_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t indiv_ct = g_indiv_ct;
+ uint32_t block_size = g_block_size;
+ double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
+ double* write_ptr;
+ double* tblock;
+ double* tblock_read_ptr;
+ double cur_tblock_val;
+ uintptr_t cur_indiv_idx;
+ uintptr_t indiv_idx2;
+ uint32_t bidx;
+ for (bidx = 0; bidx < block_size; bidx++)
+ {
+ write_ptr = write_start_ptr;
+ tblock = &(g_tblock[bidx * indiv_ct]);
+ for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ cur_tblock_val = tblock[cur_indiv_idx];
+ tblock_read_ptr = tblock;
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int block_size,
+ uint32_t indiv_ct)
{
// General case: tblock[] can have an arbitrary number of distinct values, so
// can't use bit hacks.
@@ -2880,364 +3317,405 @@ domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lowe
int ii;
double ycheck;
uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
+ for (ii = 0; ii < block_size; ii++)
+ {
+ ycheck = asum (tblock + ii * indiv_ct, indiv_ct);
+ if (fabs (ycheck) > .00001)
+ fatalx ("bad ycheck\n");
+ }
g_XTX_lower_tri = XTX_lower_tri;
g_tblock = tblock;
g_block_size = block_size;
g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_normal, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_normal ((void*) ulii);
+ join_threads (threads, thread_ct);
}
void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
+ int n;
+ double pmean, yfancy;
+ int *rawcol;
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
+ if (xmean != NULL)
+ {
+ xmean[col] = xfancy[col] = 0.0;
+ }
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
+ if (cupt->ignore)
+ {
+ vzero (xcol, nrows);
+ return;
+ }
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
}
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xinb;
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xinb, numeg, double);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
+ doinbreed (xinb, inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm);
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
+ free (blstart);
+ free (blsize);
+ free (xinb);
}
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len)
// extracted from dotttest ;
{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
+ double *w0, *w1;
+ int *isort;
+ int i, k;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(isort, len, int);
-
- calcmean(w0, vec, len, xtypes, numeg) ;
+ calcmean (w0, vec, len, xtypes, numeg);
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
+ copyarr (w0, w1, numeg);
+ sortit (w1, isort, numeg);
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ elist[i] = eglist[k];
+ wmean[i] = w0[k];
}
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
+ free (w0);
+ free (w1);
+ free (isort);
}
void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
{
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
+ int i, j, k;
+ // Indiv *indx ;
+ static int ncall = 0;
- ++ncall ;
+ ++ncall;
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
+ for (k = 0; k < nrows; ++k)
+ {
+ i = xindex[k];
+ if (i < 0)
+ fatalx ("zzyuk!\n");
+ // indx = indivmarkers[i] ;
// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ azq[j * nrows + k] = acoeffs[j * numindivs + i];
+ }
+ }
}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
+void
+dumpgrmid (char *fname, Indiv **indivmarkers, int *xindex, int numid)
{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
+ FILE *fff;
+ int a, b;
+ Indiv *indx;
+
+ openit (fname, &fff, "w");
+ for (a = 0; a < numid; ++a)
+ {
+ b = xindex[a];
+ if ((b < 0) || (b >= numindivs))
+ fatalx ("(dumpgrmid) bad index\n");
+ indx = indivmarkers[b];
+ fprintf (fff, "%s\t%s\n", "NA", indx->ID);
+ }
+ fclose (fff);
}
void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrmbin (double *XTX, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ double y;
+ char sss[256];
+ char *bb;
+ int wout, numout, fdes, ret = 0;
+ float yfloat;
+
+ if (sizeof(yfloat) != 4)
+ fatalx ("grm binary only supported for 4 byte floats\n");
+
+ sprintf (sss, "%s.N.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
+ numout = nrows * (nrows + 1) / 2;
+ wout = numsnps;
+ bb = (char *) &wout;
+
+ for (a = 0; a < numout; ++a)
+ {
+ ret = write (fdes, bb, 4);
+ }
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ close (fdes);
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ sprintf (sss, "%s.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
+ double y_norm;
+ y_norm = trace (XTX, nrows) / (double) nrows;
+
+ bb = (char *) &yfloat;
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b] / y_norm; // bugfix
+ yfloat = (float) y;
+ ret = write (fdes, bb, 4);
+ }
+ }
+ close (fdes);
}
void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
+ double y;
+ FILE *fff;
+ char sss[256];
+
+ if (grmoutname == NULL)
+ return;
+
+ sprintf (sss, "%s.id", grmoutname);
+ dumpgrmid (sss, indivmarkers, xindex, nrows);
+
+ if (grmbinary)
+ {
+ dumpgrmbin (XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname);
+ return;
+ }
// Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
+ double y_norm_recip;
+ double *d;
+ ZALLOC(d, nrows, double);
+ getdiag (d, XTX, nrows);
+ y_norm_recip = ((double) nrows) / asum (d, nrows);
+ free (d);
+
+ openit (grmoutname, &fff, "w");
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b]; // bugfix: do NOT want to dereference xindex here
+ fprintf (fff, "%d %d ", a + 1, b + 1);
+ fprintf (fff, "%d ", numsnps);
+ fprintf (fff, "%0.6f\n", y * y_norm_recip);
+ }
+ }
+ fclose (fff);
}
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile)
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile)
{
- double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y ;
- double *fxscal, *xpt, val ;
- int i, j, k ;
- Indiv *indx ;
+ double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y;
+ double *fxscal, *xpt, val;
+ int i, j, k;
+ Indiv *indx;
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", eigenvals[j]);
+ }
+ fprintf (ofile, "\n");
- if (easymode) {
+ if (easymode)
+ {
// should be separate routine
- ZALLOC(fvecs, nrows*numeigs, double) ;
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- free(fvecs) ;
- return ;
- }
+ ZALLOC(fvecs, nrows*numeigs, double);
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(xrow, ncols, double) ;
- ZALLOC(bcoeffs, numeigs*numindivs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ free (fvecs);
+ return;
+ }
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(cc, nrows, double);
+ ZALLOC(xrow, ncols, double);
+ ZALLOC(bcoeffs, numeigs*numindivs, double);
+ ZALLOC(fxscal, numeigs, double);
-
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
- for (i=0; i<ncols; i++) {
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- getgval(k, i, &val) ;
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*val ;
- }
+ for (i = 0; i < ncols; i++)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ getgval (k, i, &val);
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * val;
+ }
+ }
}
- }
- for (i=0; i<nrows; i++) {
-
- for (k=0; k<ncols; ++k) {
- getgval(i, k, &val) ;
- xrow[k] = val ;
- }
+ for (i = 0; i < nrows; i++)
+ {
- for (j=0; j<numeigs; j++) {
- xpt = ffvecs+j*ncols ;
- y = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
- }
- }
+ for (k = 0; k < ncols; ++k)
+ {
+ getgval (i, k, &val);
+ xrow[k] = val;
+ }
- vsqrt(fxscal, fxscal, numeigs) ;
- vinvert(fxscal, fxscal, numeigs) ;
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = ffvecs + j * ncols;
+ y = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
+ }
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- for (k=0; k<ncols; ++k) {
- getggval(i, k, &val) ;
- xrow[k] = val ;
- }
+ vsqrt (fxscal, fxscal, numeigs);
+ vinvert (fxscal, fxscal, numeigs);
- for (j=0; j<numeigs; j++) {
- bcoeffs[j*numindivs+i] = y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- }
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ for (k = 0; k < ncols; ++k)
+ {
+ getggval (i, k, &val);
+ xrow[k] = val;
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = bcoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ bcoeffs[j * numindivs + i] = y = fxscal[j]
+ * vdot (xrow, ffvecs + j * ncols, ncols);
+ }
+ }
- writesnpeigs(snpeigname, snpmarkers, ffvecs, numeigs, ncols) ;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = bcoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ writesnpeigs (snpeigname, snpmarkers, ffvecs, numeigs, ncols);
- free(fvecs) ;
- free(ffvecs) ;
- free(cc) ;
- free(xrow) ;
- free(bcoeffs) ;
- free(fxscal) ;
+ free (fvecs);
+ free (ffvecs);
+ free (cc);
+ free (xrow);
+ free (bcoeffs);
+ free (fxscal);
}
diff --git a/src/eigensrc/old.c b/src/eigensrc/old.c
deleted file mode 100644
index 7768659..0000000
--- a/src/eigensrc/old.c
+++ /dev/null
@@ -1,3213 +0,0 @@
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <math.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <stdint.h>
-#include <inttypes.h>
-
-#include <nicklib.h>
-#include <getpars.h>
-
-#include "badpairs.h"
-#include "admutils.h"
-#include "mcio.h"
-#include "mcmcpars.h"
-#include "eigsubs.h"
-#include "gval.h"
-#include "egsubs.h"
-#include "qpsubs.h"
-#include "smartsubs.h"
-#include "exclude.h"
-#include "globals.h"
-
-/**
- Most of this code written by Nick Patterson
- (Broad institute and Harvard Medical)
- Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
-
- Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
-
-#define WVERSION "13002"
-/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
-
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
-
-SNPs discarded if no data.
-Phylipfile now supported
-
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
-
-output capability added (like convertf)
-
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
-
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
-
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
-
-writesnpeig added
-
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
-
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
-
-fst on X
-fst std errors now fixed
-
-bad bug fixed (outfiles changed indivmarkers) ...
-
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
-
-bad bug fix. xtypes not allocated correctly
-
-version compatible with Mac
-XTX.dbg commented out
-
-outliermode added
-
-regmode added
-maxpops parametric. Use easymode if large
-
-id2pops added
-
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-*/
-
-#if _WIN32
-// just in case we try a Windows port in the future
-#include <windows.h>
-#include <process.h>
-#define pthread_t HANDLE
-#define THREAD_RET_TYPE unsigned __stdcall
-#define THREAD_RETURN return 0
-#define MAX_THREADS 63
-#define MAX_THREADS_P1 64
-#else
-#include <pthread.h>
-#define THREAD_RET_TYPE void*
-#define THREAD_RETURN return NULL
-#define MAX_THREADS 127
-#define MAX_THREADS_P1 128
-#endif
-
-#define MAXFL 50
-#define MAXSTR 512
-#define MAXPOPS 1000
-
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
-Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int fastdim = -1 ;
-int fastiter= -1 ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
-
-double nhwfilter = -1.0;
-
-int thread_ct_config = 0;
-
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
-
-int xchrom = -1 ;
-// list of outliers
-
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
-
-int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
-
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile) ;
-
-uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
-{
- // return smallest integer vv for which (vv * (vv + modif)) is no smaller
- // than cur_prod, and neither term in the product is negative. (Note the
- // lack of a divide by two; cur_prod should also be double its "true" value
- // as a result.)
- int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
- }
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
- return vv;
-}
-
-void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
-{
- int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
-}
-
-// set align to 1 for no alignment
-void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
-{
- int32_t modif = 1 - start * 2;
- uint32_t cur_piece = 1;
- int64_t ct_tr;
- int64_t cur_prod;
- int32_t lbound;
- int32_t ubound;
- uint32_t uii;
- uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
- // x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
- align *= 2;
- align_m1 = align - 1;
- target_arr[0] = lbound;
- target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
-}
-
-void
-symit2(double* XTX, uintptr_t nrows)
-{
- // unpacks LOWER-triangle-only symmetric matrix representation into regular
- // square matrix.
- uintptr_t row_idx;
- uintptr_t col_idx;
- double* read_col;
- double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
- return;
- }
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
- }
- }
-}
-
-void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
-{
- uintptr_t new_row_idx;
- uintptr_t new_col_idx;
- double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
- }
- }
-}
-
-// make these file scope so multithreading works
-static double* g_XTX_lower_tri;
-static double* g_tblock;
-static uint32_t g_block_size;
-static uintptr_t g_indiv_ct;
-static uint32_t g_thread_start[MAX_THREADS_P1];
-
-static double* g_weights;
-static uintptr_t* g_binary_cols;
-static uintptr_t* g_binary_mmask;
-
-int main(int argc, char **argv)
-{
-
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww, *evals ;
- double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
- int blocksize = 1024;
- double *tblock = NULL;
- int* binary_rawcol = NULL;
- uintptr_t* binary_cols = NULL;
- uintptr_t* binary_mmask = NULL;
-
- OUTLINFO *outpt ;
-
- pthread_t threads[MAX_THREADS];
- uint32_t thread_ct;
-
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fastmode) {
- if (fastiter < 0) fastiter = numeigs;
- if (fastdim < 0) fastdim = 2*numeigs;
- }
-
-/**
- if (fastmode) {
- printf("fastmode => easymode\n") ;
- easymode = YES ;
- }
-*/
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
-
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
-
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
-
- nostatslim = MAX(nostatslim, 3) ;
-
- outlfile = ofile = stdout;
-
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
-
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
-
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
-
- numindivs = getindivs(indivname, &indivmarkers) ;
-
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
-
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
-
-
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
-
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
-
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
- }
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
- }
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
- }
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
- {
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
- }
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
-
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
-
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
-
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
-
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
-
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
-
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
-
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
-
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
-
-
- /* Load non-ignored individuals into xindlist,xindex:
- * xindex[i] = index into indivmarkers
- * xindlist[i] = pointer to Indiv struct */
-
- ZALLOC(xtypes, numindivs, int) ;
-
-
-
- /* Load non-ignored SNPs into xsnplist:
- * xsnplist[i] = pointer to SNP struct */
-
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
-
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
-
- if (fastmode) {
-
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
-// side-effect monomorphic snps -> ignore
-
- ZALLOC(evals, numeigs, double) ;
- ZALLOC(evecs, numeigs*nrows, double) ;
-
- kjg_fpca(numeigs, fastdim, fastiter,
- evals, evecs);
-
- printf("##bug: \n") ; printmat(evals, 1, numeigs) ; printmat(evecs, 1, 20) ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
-
- transpose(evecs, evecs, nrows, numeigs) ;
-
- printevecs(xsnplist, indivmarkers, xindlist,
- numindivs, ncols, nrows, numeigs,
- evecs, evals, ofile) ;
-
-
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
-
-}
-
-
- /* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
-#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
-#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
-#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
-
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
-
- blocksize = MIN(blocksize, ncols) ;
-
- // xfancy is multiplier for column xmean is mean to take off
- // badlist is list of rows to delete (outlier removal)
-
- numoutiter = 1 ;
-
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
-
- // try to autodetect number of (virtual) processors, and use that number to
- // set the thread count. allow the user to override this in the future
-#if _WIN32
- SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
-#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
- }
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
- }
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
- }
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
- }
-
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
-
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
-
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
-
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
-
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
-
- ++xblock ;
- ++nused ;
-
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
-
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
-
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
-
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
-
- eigvecs(XTX, lambda, evecs, nrows) ;
-// eigenvalues are in decreasing order
-
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
-
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
-
- m = numgtz(lambda, nrows) ;
- /* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
-
- /* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
- else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
- }
- /* END of code to print Tracy-Widom statistics */
- }
-
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
-// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
-
- /* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
- /* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
- /* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
- /* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
-
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
-
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
- }
- }
-
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
-
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
-
- for (i=0; i<nrows; i++) {
-
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
-
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
-
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
-
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
-
-
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
-
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
-
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
-
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
-
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
-
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
-
-
-
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
-
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
-
-
-// output files
- settersemode(YES) ;
-
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
-
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
-
-
- if (numeg==1) dotpopsmode = NO ;
-
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
-
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
-
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
-
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- }
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
- }
- fclose(phylipfile) ;
- }
-
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
- }
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
- }
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
-
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
-
- printxcorr(XTX, nrows, xindlist) ;
-
-
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
-}
-
-void readcommands(int argc, char **argv)
-
-{
- int i ;
- phandle *ph ;
- int t ;
-
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
-
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "fastdim:", &fastdim) ;
- getint(ph, "fastiter:", &fastiter) ;
-
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
-
-}
-
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
-/* take off mean force missing to zero */
-/* set up fancy norming */
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
-}
-
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0;
-
- if (n == nmiss) {
- return -999;
- }
- ynum = n - nmiss;
- ysum = c0;
- ymean = ysum / ynum;
- cc[0] = -ymean;
- cc[1] = 1.0 - ymean;
- cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
- }
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
- }
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
- return nmiss;
-}
-
-double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
-// vec will always have mean 0
-// perhaps should rewrite to put xa1 etc in arrays
-{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
-
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
- }
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
- }
- ++ncall ;
-
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
- }
-
-
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
- }
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
-}
-double anova(double *vec, int len, int *xtypes, int numeg)
-// anova 1 but f statistic
-{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
-
- static int ncall2 = 0 ;
-
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
-// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ftail ;
-
-}
-double anova1(double *vec, int len, int *xtypes, int numeg)
-{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
-
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ylike ;
-
-}
-void publishit(char *sss, int df, double chi)
-{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
-
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
-}
-
-void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
-{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
-// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
-
- free(pp) ;
- free(npp) ;
-
-}
-void printxcorr(double *X, int nrows, Indiv **indxx)
-{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
-
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
-
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
-
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
-
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
-
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
-
- }
- }
-}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
-{
-
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
-
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
-
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
-
- *pnumld = numld ;
- return ;
-}
-
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
-{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
-
- // Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
-
- int i,ii;
-
- // Compute correlation to previous SNPs
- double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
- }
- }
-
- // Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ;
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ;
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
-
-
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
-
- if ( qtmode == YES ) {
- return;
- }
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
-
-}
-void fixwt(SNP **snpm, int nsnp, double val)
-{
- int k ;
- SNP *cupt ;
-
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
-
-}
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- return z + zz ;
-
-}
-
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
-// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
- }
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
-
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
-
-}
-
-void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
-{
-// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
-
-
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
- if (ncols<=10) break ;
-// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
-
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
-
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
-
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
-
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
-
- fclose(fff) ;
-
-}
-
-/* load genotype data for this SNP into rawcol (call this g[])
- * in fvadjust:
- * ymean := mean over all non-missing g[i]
- * xcol[i] -= ymean if g[i] is not missing
- * xcol[i] = 0.0 if g[i] is missing
- * if (fancynorm == NO)
- * yfancy = 1.0
- * if (fancynorm == YES and altnormstyle == NO)
- * yfancy = (ymean/2)*(1-(ymean/2))
- * if (fancynorm == YES and altnormstyle == YES)
- * yfancy = ( sum(g[i])+1 ) / ( 2*N + 2 )
- * for (sum,N) only over non-missing g[i]
- * back in getcolxz:
- * on exit:
- * xmean[ s ] = ymean * yfancy
- * xfancy[ s ] = yfancy
- * *n0 = sum( g[i] ) non-missing g[i] only
- * *n1 = sum( 2-g[i] ) non-missing g[i] only
- * g[i] set to zero where missing data
- * */
-
-
-int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
-// side effect set xmean xfancy and count variant and reference alleles
-// returns missings after fill in
-{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
-
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
-}
-
-int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
-{
- // Modified getcolxz() which converts to a 3-bit-per-genotype representation
- // compatible with PLINK 1.5's partial sum lookup outer product algorithm.
- // (Well, to be more precise, the conversion occurs in getcolxz_binary2();
- // this function handles the other duties of getcolxz().) Assumes
- // usepopsformissing is NOT set, and ldregress is zero.
- //
- // Main genotype array:
- // Homozygous minor -> 0
- // Heterozygous -> 2
- // Homozygous major -> 3
- // Missing -> 0
- //
- // Missing mask:
- // Nonmissing -> 0
- // Missing -> 7
- //
- // Suppose person 1 has genotype g_1 and missing mask m_1, and person 2 has
- // genotype g_2 and missing mask m_2. Then, the operation
- //
- // (g_1 + g_2) | m_1 | m_2
- //
- // executes the following mapping:
- //
- // Both genotypes hom minor -> 0
- // Hom minor + het -> 2
- // Hom minor + hom major -> 3
- // Het + het -> 4
- // Het + hom major -> 5
- // Hom major + hom major -> 6
- // Either genotype missing -> 7
- //
- // Construction of the corresponding lookup table is deferred to
- // domult_increment_lookup().
-
- int j, n, g, t;
- double pmean, yfancy;
- int c0, c1, nmiss;
-
- c0 = c1 = 0;
- n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
- nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
- // instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
-}
-
-void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
-{
- // slightly better to position at 0-3-6-9-12-16-19... instead of
- // 0-3-6-9-12-15-18...
- uint32_t shift_val = (xblock * 3) + (xblock / 5);
-
- uintptr_t bitfield_or[3];
- uint32_t row_idx;
- int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
- }
- }
-}
-
-void
-join_threads(pthread_t* threads, uint32_t ctp1)
-{
- if (!(--ctp1)) {
- return;
- }
-#if _WIN32
- WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
-#else
- uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
-#endif
-}
-
-#if _WIN32
-int32_t
-spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
-#else
-int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
-#endif
-{
- uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
- }
-#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
-#endif
- }
- return 0;
-}
-
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
-#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
-#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
-{
- // PLINK 1.5 partial sum lookup algorithm
- double increments[40];
- double* dptr;
- double* dptr2;
- uint32_t uii;
- uint32_t ujj;
- uint32_t ukk;
- uint32_t umm;
- uint32_t unn;
- uint32_t uoo;
- double partial_incr1;
- double partial_incr2;
- double partial_incr3;
- double partial_incr4;
- uintptr_t ulii;
-
- // populate lookup buffer
-#ifdef __LP64__
- for (uii = 0; uii < 20; uii += 5)
-#else
- for (uii = 0; uii < 10; uii += 5)
-#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
- }
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_weights = partial_sum_lookup_buf;
- g_binary_cols = binary_cols;
- g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
-{
- // General case: tblock[] can have an arbitrary number of distinct values, so
- // can't use bit hacks.
- //
- // This multithreaded implementation is pretty far from optimal; if more
- // speed is needed, use the DGEMM function from a vendor-optimized BLAS.
- // (Sum of k outer products is just equal to the product of a n*k and a k*n
- // matrix.)
- int ii;
- double ycheck;
- uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_tblock = tblock;
- g_block_size = block_size;
- g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
-// side effect set xmean xfancy
-{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
-
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
-
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
-
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
-}
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
-
-}
-
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
-// extracted from dotttest ;
-{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
-
-
- calcmean(w0, vec, len, xtypes, numeg) ;
-
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
-
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
- }
-
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
-
-}
-
-void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
-{
-
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
-
- ++ncall ;
-
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
-// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
-
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
-}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
-{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
-}
-void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
-// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
-
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
- // Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
-}
-void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
-
- // Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
-
-}
-
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile)
-
-{
-
- double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y ;
- double *fxscal, *xpt, val ;
- int i, j, k ;
- Indiv *indx ;
-
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (easymode) {
-// should be separate routine
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- free(fvecs) ;
- return ;
- }
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(xrow, ncols, double) ;
- ZALLOC(bcoeffs, numeigs*numindivs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
-
-
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (i=0; i<ncols; i++) {
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- getgval(k, i, &val) ;
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*val ;
- }
- }
- }
-
- for (i=0; i<nrows; i++) {
-
- for (k=0; k<ncols; ++k) {
- getgval(i, k, &val) ;
- xrow[k] = val ;
- }
-
- for (j=0; j<numeigs; j++) {
- xpt = ffvecs+j*ncols ;
- y = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
- }
- }
-
- vsqrt(fxscal, fxscal, numeigs) ;
- vinvert(fxscal, fxscal, numeigs) ;
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- for (k=0; k<ncols; ++k) {
- getggval(i, k, &val) ;
- xrow[k] = val ;
- }
-
- for (j=0; j<numeigs; j++) {
- bcoeffs[j*numindivs+i] = y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = bcoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
-
- writesnpeigs(snpeigname, snpmarkers, ffvecs, numeigs, ncols) ;
-
-
- free(fvecs) ;
- free(ffvecs) ;
- free(cc) ;
- free(xrow) ;
- free(bcoeffs) ;
- free(fxscal) ;
-}
diff --git a/src/eigensrc/oldfffpca.c b/src/eigensrc/oldfffpca.c
deleted file mode 100644
index 3cc9c9e..0000000
--- a/src/eigensrc/oldfffpca.c
+++ /dev/null
@@ -1,3231 +0,0 @@
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <math.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <stdint.h>
-#include <inttypes.h>
-
-#include <nicklib.h>
-#include <getpars.h>
-
-#include "badpairs.h"
-#include "admutils.h"
-#include "mcio.h"
-#include "mcmcpars.h"
-#include "eigsubs.h"
-#include "gval.h"
-#include "egsubs.h"
-#include "qpsubs.h"
-#include "smartsubs.h"
-#include "exclude.h"
-#include "globals.h"
-
-/**
- Most of this code written by Nick Patterson
- (Broad institute and Harvard Medical)
- Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
-
- Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
-
-#define WVERSION "13002"
-/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
-
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
-
-SNPs discarded if no data.
-Phylipfile now supported
-
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
-
-output capability added (like convertf)
-
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
-
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
-
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
-
-writesnpeig added
-
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
-
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
-
-fst on X
-fst std errors now fixed
-
-bad bug fixed (outfiles changed indivmarkers) ...
-
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
-
-bad bug fix. xtypes not allocated correctly
-
-version compatible with Mac
-XTX.dbg commented out
-
-outliermode added
-
-regmode added
-maxpops parametric. Use easymode if large
-
-id2pops added
-
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-*/
-
-#if _WIN32
-// just in case we try a Windows port in the future
-#include <windows.h>
-#include <process.h>
-#define pthread_t HANDLE
-#define THREAD_RET_TYPE unsigned __stdcall
-#define THREAD_RETURN return 0
-#define MAX_THREADS 63
-#define MAX_THREADS_P1 64
-#else
-#include <pthread.h>
-#define THREAD_RET_TYPE void*
-#define THREAD_RETURN return NULL
-#define MAX_THREADS 127
-#define MAX_THREADS_P1 128
-#endif
-
-#define MAXFL 50
-#define MAXSTR 512
-#define MAXPOPS 1000
-
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
-Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int fastdim = -1 ;
-int fastiter= -1 ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
-
-double nhwfilter = -1.0;
-
-int thread_ct_config = 0;
-
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
-
-int xchrom = -1 ;
-// list of outliers
-
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
-
-int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
-
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile) ;
-
-uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
-{
- // return smallest integer vv for which (vv * (vv + modif)) is no smaller
- // than cur_prod, and neither term in the product is negative. (Note the
- // lack of a divide by two; cur_prod should also be double its "true" value
- // as a result.)
- int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
- }
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
- return vv;
-}
-
-void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
-{
- int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
-}
-
-// set align to 1 for no alignment
-void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
-{
- int32_t modif = 1 - start * 2;
- uint32_t cur_piece = 1;
- int64_t ct_tr;
- int64_t cur_prod;
- int32_t lbound;
- int32_t ubound;
- uint32_t uii;
- uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
- // x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
- align *= 2;
- align_m1 = align - 1;
- target_arr[0] = lbound;
- target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
-}
-
-void
-symit2(double* XTX, uintptr_t nrows)
-{
- // unpacks LOWER-triangle-only symmetric matrix representation into regular
- // square matrix.
- uintptr_t row_idx;
- uintptr_t col_idx;
- double* read_col;
- double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
- return;
- }
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
- }
- }
-}
-
-void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
-{
- uintptr_t new_row_idx;
- uintptr_t new_col_idx;
- double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
- }
- }
-}
-
-// make these file scope so multithreading works
-static double* g_XTX_lower_tri;
-static double* g_tblock;
-static uint32_t g_block_size;
-static uintptr_t g_indiv_ct;
-static uint32_t g_thread_start[MAX_THREADS_P1];
-
-static double* g_weights;
-static uintptr_t* g_binary_cols;
-static uintptr_t* g_binary_mmask;
-
-int main(int argc, char **argv)
-{
-
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww, *evals ;
- double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
- int blocksize = 1024;
- double *tblock = NULL;
- int* binary_rawcol = NULL;
- uintptr_t* binary_cols = NULL;
- uintptr_t* binary_mmask = NULL;
-
- OUTLINFO *outpt ;
-
- pthread_t threads[MAX_THREADS];
- uint32_t thread_ct;
-
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fastmode) {
- if (fastiter < 0) fastiter = numeigs;
- if (fastdim < 0) fastdim = 2*numeigs;
- }
-
-/**
- if (fastmode) {
- printf("fastmode => easymode\n") ;
- easymode = YES ;
- }
-*/
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
-
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
-
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
-
- nostatslim = MAX(nostatslim, 3) ;
-
- outlfile = ofile = stdout;
-
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
-
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
-
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
-
- numindivs = getindivs(indivname, &indivmarkers) ;
-
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
-
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
-
-
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
-
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
-
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
- }
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
- }
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
- }
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
- {
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
- }
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
-
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
-
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
-
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
-
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
-
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
-
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
-
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
-
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
-
-
- /* Load non-ignored individuals into xindlist,xindex:
- * xindex[i] = index into indivmarkers
- * xindlist[i] = pointer to Indiv struct */
-
- ZALLOC(xtypes, numindivs, int) ;
-
-
-
- /* Load non-ignored SNPs into xsnplist:
- * xsnplist[i] = pointer to SNP struct */
-
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
-
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
-
- if (fastmode) {
-
-// temporary
- if (easymode) {
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- for (i=0; i<nrows; ++i) {
- indx = xindlist[i] ;
- indx -> ignore = NO ;
- xindex[i] = i ;
- }
-
- printf("old numindivs: %d\n", numindivs) ;
- numindivs = rmindivs(snpmarkers, numsnps, indivmarkers, numindivs) ;
- printf("new numindivs: %d\n", numindivs) ;
- }
-// end temporary hack
-
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
-// side-effect monomorphic snps -> ignore
-
- ZALLOC(evals, numeigs, double) ;
- ZALLOC(evecs, numeigs*nrows, double) ;
-
- kjg_fpca(numeigs, fastdim, fastiter,
- evals, evecs);
-
- printf("##bug: \n") ; printmat(evals, 1, numeigs) ; printmat(evecs, 1, 20) ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
-
- transpose(evecs, evecs, nrows, numeigs) ;
-
- printevecs(xsnplist, indivmarkers, xindlist,
- numindivs, ncols, nrows, numeigs,
- evecs, evals, ofile) ;
-
-
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
-
-}
-
-
- /* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
-#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
-#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
-#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
-
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
-
- blocksize = MIN(blocksize, ncols) ;
-
- // xfancy is multiplier for column xmean is mean to take off
- // badlist is list of rows to delete (outlier removal)
-
- numoutiter = 1 ;
-
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
-
- // try to autodetect number of (virtual) processors, and use that number to
- // set the thread count. allow the user to override this in the future
-#if _WIN32
- SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
-#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
- }
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
- }
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
- }
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
- }
-
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
-
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
-
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
-
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
-
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
-
- ++xblock ;
- ++nused ;
-
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
-
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
-
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
-
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
-
- eigvecs(XTX, lambda, evecs, nrows) ;
-// eigenvalues are in decreasing order
-
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
-
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
-
- m = numgtz(lambda, nrows) ;
- /* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
-
- /* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
- else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
- }
- /* END of code to print Tracy-Widom statistics */
- }
-
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
-// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
-
- /* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
- /* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
- /* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
- /* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
-
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
-
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
- }
- }
-
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
-
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
-
- for (i=0; i<nrows; i++) {
-
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
-
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
-
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
-
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
-
-
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
-
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
-
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
-
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
-
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
-
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
-
-
-
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
-
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
-
-
-// output files
- settersemode(YES) ;
-
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
-
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
-
-
- if (numeg==1) dotpopsmode = NO ;
-
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
-
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
-
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
-
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- }
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
- }
- fclose(phylipfile) ;
- }
-
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
- }
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
- }
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
-
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
-
- printxcorr(XTX, nrows, xindlist) ;
-
-
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
-}
-
-void readcommands(int argc, char **argv)
-
-{
- int i ;
- phandle *ph ;
- int t ;
-
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
-
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "fastdim:", &fastdim) ;
- getint(ph, "fastiter:", &fastiter) ;
-
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
-
-}
-
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
-/* take off mean force missing to zero */
-/* set up fancy norming */
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
-}
-
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0;
-
- if (n == nmiss) {
- return -999;
- }
- ynum = n - nmiss;
- ysum = c0;
- ymean = ysum / ynum;
- cc[0] = -ymean;
- cc[1] = 1.0 - ymean;
- cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
- }
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
- }
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
- return nmiss;
-}
-
-double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
-// vec will always have mean 0
-// perhaps should rewrite to put xa1 etc in arrays
-{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
-
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
- }
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
- }
- ++ncall ;
-
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
- }
-
-
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
- }
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
-}
-double anova(double *vec, int len, int *xtypes, int numeg)
-// anova 1 but f statistic
-{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
-
- static int ncall2 = 0 ;
-
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
-// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ftail ;
-
-}
-double anova1(double *vec, int len, int *xtypes, int numeg)
-{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
-
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ylike ;
-
-}
-void publishit(char *sss, int df, double chi)
-{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
-
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
-}
-
-void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
-{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
-// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
-
- free(pp) ;
- free(npp) ;
-
-}
-void printxcorr(double *X, int nrows, Indiv **indxx)
-{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
-
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
-
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
-
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
-
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
-
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
-
- }
- }
-}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
-{
-
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
-
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
-
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
-
- *pnumld = numld ;
- return ;
-}
-
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
-{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
-
- // Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
-
- int i,ii;
-
- // Compute correlation to previous SNPs
- double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
- }
- }
-
- // Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ;
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ;
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
-
-
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
-
- if ( qtmode == YES ) {
- return;
- }
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
-
-}
-void fixwt(SNP **snpm, int nsnp, double val)
-{
- int k ;
- SNP *cupt ;
-
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
-
-}
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- return z + zz ;
-
-}
-
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
-// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
- }
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
-
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
-
-}
-
-void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
-{
-// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
-
-
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
- if (ncols<=10) break ;
-// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
-
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
-
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
-
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
-
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
-
- fclose(fff) ;
-
-}
-
-/* load genotype data for this SNP into rawcol (call this g[])
- * in fvadjust:
- * ymean := mean over all non-missing g[i]
- * xcol[i] -= ymean if g[i] is not missing
- * xcol[i] = 0.0 if g[i] is missing
- * if (fancynorm == NO)
- * yfancy = 1.0
- * if (fancynorm == YES and altnormstyle == NO)
- * yfancy = (ymean/2)*(1-(ymean/2))
- * if (fancynorm == YES and altnormstyle == YES)
- * yfancy = ( sum(g[i])+1 ) / ( 2*N + 2 )
- * for (sum,N) only over non-missing g[i]
- * back in getcolxz:
- * on exit:
- * xmean[ s ] = ymean * yfancy
- * xfancy[ s ] = yfancy
- * *n0 = sum( g[i] ) non-missing g[i] only
- * *n1 = sum( 2-g[i] ) non-missing g[i] only
- * g[i] set to zero where missing data
- * */
-
-
-int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
-// side effect set xmean xfancy and count variant and reference alleles
-// returns missings after fill in
-{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
-
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
-}
-
-int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
-{
- // Modified getcolxz() which converts to a 3-bit-per-genotype representation
- // compatible with PLINK 1.5's partial sum lookup outer product algorithm.
- // (Well, to be more precise, the conversion occurs in getcolxz_binary2();
- // this function handles the other duties of getcolxz().) Assumes
- // usepopsformissing is NOT set, and ldregress is zero.
- //
- // Main genotype array:
- // Homozygous minor -> 0
- // Heterozygous -> 2
- // Homozygous major -> 3
- // Missing -> 0
- //
- // Missing mask:
- // Nonmissing -> 0
- // Missing -> 7
- //
- // Suppose person 1 has genotype g_1 and missing mask m_1, and person 2 has
- // genotype g_2 and missing mask m_2. Then, the operation
- //
- // (g_1 + g_2) | m_1 | m_2
- //
- // executes the following mapping:
- //
- // Both genotypes hom minor -> 0
- // Hom minor + het -> 2
- // Hom minor + hom major -> 3
- // Het + het -> 4
- // Het + hom major -> 5
- // Hom major + hom major -> 6
- // Either genotype missing -> 7
- //
- // Construction of the corresponding lookup table is deferred to
- // domult_increment_lookup().
-
- int j, n, g, t;
- double pmean, yfancy;
- int c0, c1, nmiss;
-
- c0 = c1 = 0;
- n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
- nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
- // instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
-}
-
-void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
-{
- // slightly better to position at 0-3-6-9-12-16-19... instead of
- // 0-3-6-9-12-15-18...
- uint32_t shift_val = (xblock * 3) + (xblock / 5);
-
- uintptr_t bitfield_or[3];
- uint32_t row_idx;
- int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
- }
- }
-}
-
-void
-join_threads(pthread_t* threads, uint32_t ctp1)
-{
- if (!(--ctp1)) {
- return;
- }
-#if _WIN32
- WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
-#else
- uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
-#endif
-}
-
-#if _WIN32
-int32_t
-spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
-#else
-int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
-#endif
-{
- uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
- }
-#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
-#endif
- }
- return 0;
-}
-
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
-#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
-#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
-{
- // PLINK 1.5 partial sum lookup algorithm
- double increments[40];
- double* dptr;
- double* dptr2;
- uint32_t uii;
- uint32_t ujj;
- uint32_t ukk;
- uint32_t umm;
- uint32_t unn;
- uint32_t uoo;
- double partial_incr1;
- double partial_incr2;
- double partial_incr3;
- double partial_incr4;
- uintptr_t ulii;
-
- // populate lookup buffer
-#ifdef __LP64__
- for (uii = 0; uii < 20; uii += 5)
-#else
- for (uii = 0; uii < 10; uii += 5)
-#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
- }
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_weights = partial_sum_lookup_buf;
- g_binary_cols = binary_cols;
- g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
-{
- // General case: tblock[] can have an arbitrary number of distinct values, so
- // can't use bit hacks.
- //
- // This multithreaded implementation is pretty far from optimal; if more
- // speed is needed, use the DGEMM function from a vendor-optimized BLAS.
- // (Sum of k outer products is just equal to the product of a n*k and a k*n
- // matrix.)
- int ii;
- double ycheck;
- uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_tblock = tblock;
- g_block_size = block_size;
- g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
-// side effect set xmean xfancy
-{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
-
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
-
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
-
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
-}
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
-
-}
-
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
-// extracted from dotttest ;
-{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
-
-
- calcmean(w0, vec, len, xtypes, numeg) ;
-
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
-
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
- }
-
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
-
-}
-
-void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
-{
-
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
-
- ++ncall ;
-
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
-// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
-
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
-}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
-{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
-}
-void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
-// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
-
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
- // Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
-}
-void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
-
- // Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
-
-}
-
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile)
-
-{
-
- double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y ;
- double *fxscal, *xpt, val ;
- int i, j, k ;
- Indiv *indx ;
-
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (easymode) {
-// should be separate routine
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- free(fvecs) ;
- return ;
- }
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(xrow, ncols, double) ;
- ZALLOC(bcoeffs, numeigs*numindivs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
-
-
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (i=0; i<ncols; i++) {
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- getgval(k, i, &val) ;
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*val ;
- }
- }
- }
-
- for (i=0; i<nrows; i++) {
-
- for (k=0; k<ncols; ++k) {
- getgval(i, k, &val) ;
- xrow[k] = val ;
- }
-
- for (j=0; j<numeigs; j++) {
- xpt = ffvecs+j*ncols ;
- y = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
- }
- }
-
- vsqrt(fxscal, fxscal, numeigs) ;
- vinvert(fxscal, fxscal, numeigs) ;
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- for (k=0; k<ncols; ++k) {
- getggval(i, k, &val) ;
- xrow[k] = val ;
- }
-
- for (j=0; j<numeigs; j++) {
- bcoeffs[j*numindivs+i] = y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = bcoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
-
- writesnpeigs(snpeigname, snpmarkers, ffvecs, numeigs, ncols) ;
-
-
- free(fvecs) ;
- free(ffvecs) ;
- free(cc) ;
- free(xrow) ;
- free(bcoeffs) ;
- free(fxscal) ;
-}
diff --git a/src/eigensrc/pcatoy.c b/src/eigensrc/pcatoy.c
index 9763005..bd66769 100644
--- a/src/eigensrc/pcatoy.c
+++ b/src/eigensrc/pcatoy.c
@@ -4,7 +4,8 @@
#include "eigsubs.h"
#include <unistd.h>
-int main()
+int
+main ()
{
int NSAMPLES, n, k;
double *eval, *evec, *XTX;
@@ -12,27 +13,39 @@ int main()
NSAMPLES = 2;
/* malloc */
- if((eval = (double *) malloc(NSAMPLES*sizeof(*eval))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((evec = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*evec))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((XTX = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*XTX))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
+ if ((eval = (double *) malloc (NSAMPLES * sizeof(*eval))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((evec = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*evec))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((XTX = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*XTX))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
- XTX[0] = 1; XTX[1] = 0; XTX[2] = 0; XTX[3] = 1; /* 2x2 identity matrix */
+ XTX[0] = 1;
+ XTX[1] = 0;
+ XTX[2] = 0;
+ XTX[3] = 1; /* 2x2 identity matrix */
- eigvecs(XTX, eval, evec, NSAMPLES); /* eigenvector k is evec[k*NSAMPLES+n] */
+ eigvecs (XTX, eval, evec, NSAMPLES); /* eigenvector k is evec[k*NSAMPLES+n] */
/* print eval and evec */
- printf("The eigenvectors of the 2x2 identity matrix are:\n");
- for(n=0; n<NSAMPLES; n++)
- {
- for(k=0; k<NSAMPLES; k++)
+ printf ("The eigenvectors of the 2x2 identity matrix are:\n");
+ for (n = 0; n < NSAMPLES; n++)
{
- printf(" ");
- printf("%.02f",evec[k*NSAMPLES+n]);
+ for (k = 0; k < NSAMPLES; k++)
+ {
+ printf (" ");
+ printf ("%.02f", evec[k * NSAMPLES + n]);
+ }
+ printf ("\n");
}
- printf("\n");
- }
return 0;
}
diff --git a/src/eigensrc/q1 b/src/eigensrc/q1
deleted file mode 100644
index 11b0ace..0000000
--- a/src/eigensrc/q1
+++ /dev/null
@@ -1,105 +0,0 @@
-smarteigenstrat.c: fatalx("bad params\n") ;
-smartpca.0.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartpca.0.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartpca.0.c: if (m==0) fatalx("no data\n") ;
-smartpca.0.c: fatalx("bad params\n") ;
-smartpca.0.c: fatalx("(fvadjust) snp has no data\n") ;
-smartpca.0.c: if (k1 < 0) fatalx("bug\n") ;
-smartpca.0.c: if (k2 < 0) fatalx("bug\n") ;
-smartpca.0.c: if (k1>=numeg) fatalx("bug\n") ;
-smartpca.0.c: if (k2>=numeg) fatalx("bug\n") ;
-smartpca.0.c: if (nclear>rsize) fatalx("bad nclear\n") ;
-smartpca.0.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.0.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n") ;
-smartpca.0.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.0.c: if(numxtxblocksperside <= 0) fatalx("Number of xtx blocks per side must be greater than 0.");
-smartpca.0.c: if(numsnppartitions <= 0) fatalx("Number of SNP partitions must be greater than 0.");
-smartpca.0.c: if(numthreads <= 0) fatalx("Number of threads must be greater than 0.");
-smartpca.1.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartpca.1.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartpca.1.c: if (m==0) fatalx("no data\n") ;
-smartpca.1.c: fatalx("bad params\n") ;
-smartpca.1.c: if (k1 < 0) fatalx("bug\n") ;
-smartpca.1.c: if (k2 < 0) fatalx("bug\n") ;
-smartpca.1.c: if (k1>=numeg) fatalx("bug\n") ;
-smartpca.1.c: if (k2>=numeg) fatalx("bug\n") ;
-smartpca.1.c: if (nclear>rsize) fatalx("bad nclear\n") ;
-smartpca.1.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.1.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n") ;
-smartpca.1.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.1.c: if (kk != nrows) fatalx("(szq) bad count %d %d\n", nrows, kk) ;
-smartpca.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartpca.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartpca.c: if (m==0) fatalx("no data\n") ;
-smartpca.c: fatalx("bad params\n") ;
-smartpca.c: if (k1 < 0) fatalx("bug\n") ;
-smartpca.c: if (k2 < 0) fatalx("bug\n") ;
-smartpca.c: if (k1>=numeg) fatalx("bug\n") ;
-smartpca.c: if (k2>=numeg) fatalx("bug\n") ;
-smartpca.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.c: fatalx("bad snp: %s %d\n", cupt->ID, n);
-smartpca.c: fatalx("Error: Failed to create thread.\n");
-smartpca.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
-smartpca.c: fatalx("Error: Failed to create thread.\n");
-smartpca.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca.c: if (i<0) fatalx("zzyuk!\n") ;
-smartpca.c: if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
-smartpca.c: if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-smartpca.c: fatalx("open failed for %s\n", sss) ;
-smartpca.c: fatalx("(outpack) bad write") ;
-smartpca.c: fatalx("open failed for %s\n", sss) ;
-smartpca_new.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartpca_new.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartpca_new.c: if (m==0) fatalx("no data\n") ;
-smartpca_new.c: fatalx("bad params\n") ;
-smartpca_new.c: if (k1 < 0) fatalx("bug\n") ;
-smartpca_new.c: if (k2 < 0) fatalx("bug\n") ;
-smartpca_new.c: if (k1>=numeg) fatalx("bug\n") ;
-smartpca_new.c: if (k2>=numeg) fatalx("bug\n") ;
-smartpca_new.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca_new.c: fatalx("bad snp: %s %d\n", cupt->ID, n);
-smartpca_new.c: fatalx("Error: Failed to create thread.\n");
-smartpca_new.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
-smartpca_new.c: fatalx("Error: Failed to create thread.\n");
-smartpca_new.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca_new.c: if (i<0) fatalx("zzyuk!\n") ;
-smartpca_new.c: if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
-smartpca_new.c: if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-smartpca_new.c: fatalx("open failed for %s\n", sss) ;
-smartpca_new.c: fatalx("(outpack) bad write") ;
-smartpca_new.c: fatalx("open failed for %s\n", sss) ;
-smartpca_old.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartpca_old.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartpca_old.c: if (m==0) fatalx("no data\n") ;
-smartpca_old.c: fatalx("bad params\n") ;
-smartpca_old.c: if (k1 < 0) fatalx("bug\n") ;
-smartpca_old.c: if (k2 < 0) fatalx("bug\n") ;
-smartpca_old.c: if (k1>=numeg) fatalx("bug\n") ;
-smartpca_old.c: if (k2>=numeg) fatalx("bug\n") ;
-smartpca_old.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca_old.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca_old.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
-smartpca_old.c: fatalx("Error: Failed to create thread.\n");
-smartpca_old.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartpca_old.c: if (i<0) fatalx("zzyuk!\n") ;
-smartpca_old.c: if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
-smartpca_old.c: if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-smartpca_old.c: fatalx("open failed for %s\n", sss) ;
-smartpca_old.c: fatalx("(outpack) bad write") ;
-smartpca_old.c: fatalx("open failed for %s\n", sss) ;
-smartrel.c: if (isnan(y)) fatalx("bad XTX matrix\n") ;
-smartrel.c: if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
-smartrel.c: if (m==0) fatalx("no data\n") ;
-smartrel.c: fatalx("bad params\n") ;
-smartrel.c: fatalx("(fvadjust) snp has no data\n") ;
-smartrel.c: if (numeg >= len) fatalx("bad anova\n") ;
-smartrel.c: if (k1 < 0) fatalx("bug\n") ;
-smartrel.c: if (k2 < 0) fatalx("bug\n") ;
-smartrel.c: if (k1>=numeg) fatalx("bug\n") ;
-smartrel.c: if (k2>=numeg) fatalx("bug\n") ;
-smartrel.c: if (nclear>rsize) fatalx("bad nclear\n") ;
-smartrel.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-smartrel.c: if (fabs(ycheck)>.00001) fatalx("bad ycheck\n") ;
-smartrel.c: if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
-twstats.c: if (iname==NULL) fatalx("i paraameter compulsory\n") ;
-twstats.c: fatalx("bad params\n") ;
diff --git a/src/eigensrc/qdiff b/src/eigensrc/qdiff
deleted file mode 100644
index 47e122b..0000000
--- a/src/eigensrc/qdiff
+++ /dev/null
@@ -1,1000 +0,0 @@
-9,10d8
-< #include <stdint.h>
-< #include <inttypes.h>
-114,129d111
-< #if _WIN32
-< // just in case we try a Windows port in the future
-< #include <windows.h>
-< #include <process.h>
-< #define pthread_t HANDLE
-< #define THREAD_RET_TYPE unsigned __stdcall
-< #define THREAD_RETURN return 0
-< #define MAX_THREADS 63
-< #define MAX_THREADS_P1 64
-< #else
-< #include <pthread.h>
-< #define THREAD_RET_TYPE void*
-< #define THREAD_RETURN return NULL
-< #define MAX_THREADS 127
-< #define MAX_THREADS_P1 128
-< #endif
-217,218d198
-< int thread_ct_config = 0;
-<
-254,260c234
-< int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-< int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
-< int nrows, int col, double* xmean, double* xfancy,
-< int* n0, int* n1);
-< void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
-< uintptr_t* binary_mmask, uint32_t xblock,
-< uint32_t nrows);
----
-> int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-262c236
-< void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
----
-> double doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
-297,298c271
-< void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-< void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
----
-> void domult(double *tvecs, double *tblock, int numrow, int len) ;
-300c273
-< void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
----
-> double dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
-304,373c277
-< void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-<
-< uint32_t
-< triangle_divide(int64_t cur_prod, int32_t modif)
-< {
-< // return smallest integer vv for which (vv * (vv + modif)) is no smaller
-< // than cur_prod, and neither term in the product is negative. (Note the
-< // lack of a divide by two; cur_prod should also be double its "true" value
-< // as a result.)
-< int64_t vv;
-< if (cur_prod == 0) {
-< if (modif < 0) {
-< return -modif;
-< } else {
-< return 0;
-< }
-< }
-< vv = (int64_t)sqrt((double)cur_prod);
-< while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
-< vv--;
-< }
-< while (vv * (vv + modif) < cur_prod) {
-< vv++;
-< }
-< return vv;
-< }
-<
-< void
-< parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
-< {
-< int32_t modif = 1 - start * 2;
-< int64_t ct_tot = ((int64_t)ct) * (ct + modif);
-< *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
-< *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
-< }
-<
-< // set align to 1 for no alignment
-< void
-< triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
-< {
-< int32_t modif = 1 - start * 2;
-< uint32_t cur_piece = 1;
-< int64_t ct_tr;
-< int64_t cur_prod;
-< int32_t lbound;
-< int32_t ubound;
-< uint32_t uii;
-< uint32_t align_m1;
-< parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
-< // x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
-< align *= 2;
-< align_m1 = align - 1;
-< target_arr[0] = lbound;
-< target_arr[pieces] = ubound;
-< cur_prod = ((int64_t)lbound) * (lbound + modif);
-< ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
-< while (cur_piece < pieces) {
-< cur_prod += ct_tr;
-< lbound = triangle_divide(cur_prod, modif);
-< uii = (lbound - ((int32_t)start)) & align_m1;
-< if ((uii) && (uii != align_m1)) {
-< lbound = start + ((lbound - ((int32_t)start)) | align_m1);
-< }
-< // lack of this check caused a nasty bug earlier
-< if (((uint32_t)lbound) > ct) {
-< lbound = ct;
-< }
-< target_arr[cur_piece++] = lbound;
-< }
-< }
----
-> void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-375,428d278
-< void
-< symit2(double* XTX, uintptr_t nrows)
-< {
-< // unpacks LOWER-triangle-only symmetric matrix representation into regular
-< // square matrix.
-< uintptr_t row_idx;
-< uintptr_t col_idx;
-< double* read_col;
-< double* write_ptr;
-< if (nrows < 3) {
-< if (nrows < 2) {
-< return;
-< }
-< // special case, need to avoid overlapping memcpy
-< XTX[3] = XTX[2];
-< XTX[2] = XTX[1];
-< return;
-< }
-< for (row_idx = nrows - 1; row_idx; row_idx--) {
-< memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
-< }
-< for (row_idx = 0; row_idx < nrows; row_idx++) {
-< read_col = &(XTX[row_idx]);
-< write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
-< for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
-< *write_ptr++ = read_col[col_idx * nrows];
-< }
-< }
-< }
-<
-< void
-< copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
-< {
-< uintptr_t new_row_idx;
-< uintptr_t new_col_idx;
-< double* orig_col_ptr;
-< for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
-< orig_col_ptr = &(orig_matrix[new_row_idx]);
-< for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
-< *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
-< }
-< }
-< }
-<
-< // make these file scope so multithreading works
-< static double* g_XTX_lower_tri;
-< static double* g_tblock;
-< static uint32_t g_block_size;
-< static uintptr_t g_indiv_ct;
-< static uint32_t g_thread_start[MAX_THREADS_P1];
-<
-< static double* g_weights;
-< static uintptr_t* g_binary_cols;
-< static uintptr_t* g_binary_mmask;
-433a284,286
-> int **snppos ;
-> int *snpindx ;
-> char **snpnamelist, **indnamelist ;
-435c288
-< int numeg ;
----
-> int lsnplist, lindlist, numeg ;
-438c291
-< SNP *cupt ;
----
-> SNP *cupt, *cupt1, *cupt2, *cupt3 ;
-440c293,294
-< double y1 = 0, y2, y2l, y, y3 ;
----
-> double y1, y2, y2l, y, y3 ;
-> FILE *twxtestfp;
-442c296,298
-< int n0, n1, nkill ;
----
-> int ch1, ch2 ;
-> int fmnum , lmnum ;
-> int num, n0, n1, nkill ;
-444c300,301
-< int nindiv = 0 ;
----
-> int nindiv = 0, e, f, lag=1 ;
-> double xc[9], xd[4], xc2[9] ;
-452,453c309
-< double *XTX, *cc, *evecs, *ww ;
-< double* partial_sum_lookup_buf = NULL;
----
-> double *XTX, *cc, *evecs, *ww, weight, *qvec, *qcoord ;
-454a311
-> double *tvecs ;
-459,460c316,317
-< double ynrows ;
-< int t, tt ;
----
-> double chisq, ynrows ;
-> int *numhits, t, g, tt ;
-462,463c319,320
-< double *ldvv = NULL , ynumsnps = 0 ; // for grm
-< int *ldsnpbuff = NULL ;
----
-> double *ldvv, ynumsnps ; // for grm
-> int *ldsnpbuff ;
-468c325,326
-< int chrom ;
----
-> int chrom, numclear ;
-> double gdis ;
-469a328
-> int a, b, kmax, kmin ;
-470a330
-> double **eigmoment, **eigindmoment ;
-471a332
-> double *snpsc ;
-475c336
-< double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
----
-> double *trow, *rhs, *emat, *regans ;
-480,485c341,342
-< int xblock ;
-< int blocksize = 1024;
-< double *tblock = NULL;
-< int* binary_rawcol = NULL;
-< uintptr_t* binary_cols = NULL;
-< uintptr_t* binary_mmask = NULL;
----
-> int xblock, blocksize=10000 ;
-> double *tblock ;
-489,491d345
-< pthread_t threads[MAX_THREADS];
-< uint32_t thread_ct;
-<
-694,714c548,550
-< ZALLOC(XTX, nrows*nrows, double) ;
-< ZALLOC(evecs, nrows*nrows, double) ;
-< if ((!usepopsformissing) && (ldregress == 0)) {
-< // should not use lookup table if
-< // - usepopsformissing is set (since each population may have a different
-< // mean), or
-< // - ldregress > 0
-< #ifdef __LP64__
-< blocksize = 20;
-< ZALLOC(partial_sum_lookup_buf, 131072, double);
-< #else
-< blocksize = 10;
-< ZALLOC(partial_sum_lookup_buf, 65536, double);
-< #endif
-< ZALLOC(binary_rawcol, nrows, int);
-< ZALLOC(binary_cols, nrows, uintptr_t);
-< ZALLOC(binary_mmask, nrows, uintptr_t);
-< ZALLOC(tblock, 3 * blocksize, double);
-< } else {
-< ZALLOC(tblock, nrows*blocksize, double) ;
-< }
----
-> ZALLOC(XTX, nrows*nrows, double) ;
-> ZALLOC(evecs, nrows*nrows, double) ;
-> ZALLOC(tvecs, nrows*nrows, double) ;
-718c554
-< ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
----
-> ZALLOC(cc, nrows, double) ;
-722a559
-> ZALLOC(tblock, nrows*blocksize, double) ;
-742,779d578
-< // try to autodetect number of (virtual) processors, and use that number to
-< // set the thread count. allow the user to override this in the future
-< #if _WIN32
-< SYSTEM_INFO sysinfo;
-< if (thread_ct_config <= 0) {
-< GetSystemInfo(&sysinfo);
-< thread_ct = sysinfo.dwNumberOfProcessors;
-< } else {
-< thread_ct = thread_ct_config;
-< }
-< #else
-< if (thread_ct_config <= 0) {
-< i = sysconf(_SC_NPROCESSORS_ONLN);
-< if (i == -1) {
-< thread_ct = 1;
-< } else {
-< thread_ct = i;
-< }
-< } else {
-< thread_ct = thread_ct_config;
-< }
-< #endif
-< if (thread_ct > 8) {
-< if (thread_ct > MAX_THREADS) {
-< thread_ct = MAX_THREADS;
-< } else {
-< thread_ct--;
-< }
-< }
-< if (thread_ct > nrows * 2) {
-< thread_ct = nrows / 2;
-< if (!thread_ct) {
-< thread_ct = 1;
-< }
-< }
-< printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
-< triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-<
-793c592,593
-< vzero(XTX, (nrows*(nrows+1)) / 2) ;
----
-> vzero(XTX, nrows*nrows) ;
-> vzero(tblock, nrows*blocksize) ;
-805a606
->
-808,819c609
-< ynumsnps = 0 ;
-< if (partial_sum_lookup_buf) {
-< for (i = 0; i < nrows; i++) {
-< binary_cols[i] = 0;
-< }
-< for (i = 0; i < nrows; i++) {
-< binary_mmask[i] = 0;
-< }
-< vzero(tblock, 3 * blocksize);
-< } else {
-< vzero(tblock, nrows*blocksize) ;
-< }
----
-> ynumsnps = 0 ; ;
-823,827c613
-< if (!partial_sum_lookup_buf) {
-< tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
-< } else {
-< tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
-< }
----
-> tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
-832,839c618,631
-< t = MAX(t, 0) ;
-< tt = MAX(tt, 0) ;
-< cupt -> ignore = YES ;
-< logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
-< vzero(cc, nrows) ;
-< if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
-< ++nkill ;
-< continue ;
----
-> t = MAX(t, 0) ;
-> tt = MAX(tt, 0) ;
-> cupt -> ignore = YES ;
-> logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
-> vzero(cc, nrows) ;
-> if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
-> ++nkill ;
-> continue ;
-> }
->
-> if (weightmode)
-> {
-> weight = xsnplist[i] -> weight ;
-> vst(cc, cc, xsnplist[i] -> weight, nrows) ;
-844,875c636,650
-< if (!partial_sum_lookup_buf) {
-< if (weightmode)
-< {
-< vst(cc, cc, xsnplist[i] -> weight, nrows) ;
-< }
-<
-<
-< if (ldregress>0)
-< {
-<
-< t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
-< if (t<2) {
-< bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
-< lastldchrom = chrom ;
-< ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
-< // don't need to think hard about how cc is normalizes
-< } else {
-< // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
-< bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
-< lastldchrom = chrom ;
-< }
-< copyarr(ww, cc, nrows) ;
-< }
-< else ++ynumsnps ;
-< copyarr(cc, tblock+xblock*nrows, nrows) ;
-< } else {
-< getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
-< if (weightmode) {
-< vst(cc, cc, xsnplist[i]->weight, 3);
-< }
-< ++ynumsnps;
-< copyarr(cc, &(tblock[xblock * 3]), 3);
----
-> if (ldregress>0)
->
-> {
-> t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
-> if (t<2) {
-> bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
-> lastldchrom = chrom ;
-> ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
-> // don't need to think hard about how cc is normalizes
-> } else {
-> // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
-> bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
-> lastldchrom = chrom ;
-> }
-> copyarr(ww, cc, nrows) ;
-876a652
-> else ++ynumsnps ;
-877a654
-> copyarr(cc, tblock+xblock*nrows, nrows) ;
-883,896c660,662
-< {
-< if (partial_sum_lookup_buf) {
-< domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
-< for (j = 0; j < nrows; j++) {
-< binary_cols[j] = 0;
-< }
-< for (j = 0; j < nrows; j++) {
-< binary_mmask[j] = 0;
-< }
-< vzero(tblock, 3 * blocksize);
-< } else {
-< domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
-< vzero(tblock, nrows*blocksize) ;
-< }
----
-> {
-> domult(tvecs, tblock, xblock, nrows) ;
-> vvp(XTX, XTX, tvecs, nrows*nrows) ;
-897a664
-> vzero(tblock, nrows*blocksize) ;
-902,907c669,671
-< {
-< if (partial_sum_lookup_buf) {
-< domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
-< } else {
-< domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
-< }
----
-> {
-> domult(tvecs, tblock, xblock, nrows) ;
-> vvp(XTX, XTX, tvecs, nrows*nrows) ;
-909c673
-< symit2(XTX, nrows) ;
----
-> symit(XTX, nrows) ;
-945,946c709
-< dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
-< printf("grm dumped\n");
----
-> dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
-995a759
->
-1037a802
->
-1094a860,862
-> eigmoment = initarray_2Ddouble(numeigs, 5, 0.0) ;
-> eigindmoment = initarray_2Ddouble(numeigs, 5, 0.0) ;
->
-1130,1136c898
-< if (partial_sum_lookup_buf) {
-< free(partial_sum_lookup_buf);
-< free(binary_rawcol);
-< free(binary_cols);
-< free(binary_mmask);
-< }
-< free(tblock);
----
-> free(tvecs) ;
-1244,1246d1005
-< for (i = 0; i < numeg; i++) {
-< xpopsize[i] = 0;
-< }
-1408c1167
-< int i ;
----
-> int i,haploid=0;
-1410c1169,1171
-< int t ;
----
-> char str[5000] ;
-> char *tempname ;
-> int n, t ;
-1545,1546d1305
-< getint(ph, "numthreads:", &thread_ct_config) ;
-<
-1590,1621d1348
-< int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
-< {
-< double p, ynum, ysum, y, ymean, yfancy = 1.0;
-<
-< if (n == nmiss) {
-< return -999;
-< }
-< ynum = n - nmiss;
-< ysum = c0;
-< ymean = ysum / ynum;
-< cc[0] = -ymean;
-< cc[1] = 1.0 - ymean;
-< cc[2] = 2.0 - ymean;
-< if (fancynorm) {
-< p = 0.5*ymean;
-< if (altnormstyle == NO) {
-< p = (ysum+1.0)/(2.0*ynum+2.0);
-< }
-< y = p * (1.0-p);
-< if (y>0.0) {
-< yfancy = 1.0/sqrt(y);
-< }
-< }
-< if (pmean) {
-< *pmean = ymean;
-< }
-< if (fancy) {
-< *fancy = yfancy;
-< }
-< return nmiss;
-< }
-<
-1629,1630c1356,1357
-< int i, k1, k2, k, n, x1, x2 ;
-< double ylike ;
----
-> int i, k1, k2, k, j, n, x1, x2 ;
-> double y1, y2, ylike, yl0, yl1, yl2 ;
-1638c1365,1366
-< double ans, ftail, ftailx, ansx ;
----
-> char sshit[4] ;
-> double tail, ans, ftail, ftailx, ansx ;
-1725c1453
-< double y1, top, bot, ftail ;
----
-> double y1, y2, ylike, top, bot, ftail ;
-1843c1571
-< printf("%40s %6d %9.3f",ss2, df, chi) ;
----
-> printf("%40s %6d %9.3f",ss2, ss2, df, chi) ;
-2094c1822
-< void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
----
-> double dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
-2098a1827
-> int t1, t2 ;
-2099a1829
-> double y, sd ;
-2386a2117
-> Indiv *indx ;
-2388c2119
-< double y, pmean, yfancy ;
----
-> double y, pmean, p, yfancy ;
-2389a2121
-> int **ccc ;
-2391,2392c2123
-< double* popnum = NULL;
-< double* popsum = NULL;
----
-> double *popnum, *popsum ;
-2403a2135
-> t = 0 ;
-2417a2150
-> ++t ;
-2448c2181
-< return -1;
----
-> return ;
-2466,2550c2199
-<
-< int
-< getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
-< int col, double* xmean, double* xfancy, int* n0, int* n1)
-< {
-< // Modified getcolxz() which converts to a 3-bit-per-genotype representation
-< // compatible with PLINK 1.5's partial sum lookup outer product algorithm.
-< // (Well, to be more precise, the conversion occurs in getcolxz_binary2();
-< // this function handles the other duties of getcolxz().) Assumes
-< // usepopsformissing is NOT set, and ldregress is zero.
-< //
-< // Main genotype array:
-< // Homozygous minor -> 0
-< // Heterozygous -> 2
-< // Homozygous major -> 3
-< // Missing -> 0
-< //
-< // Missing mask:
-< // Nonmissing -> 0
-< // Missing -> 7
-< //
-< // Suppose person 1 has genotype g_1 and missing mask m_1, and person 2 has
-< // genotype g_2 and missing mask m_2. Then, the operation
-< //
-< // (g_1 + g_2) | m_1 | m_2
-< //
-< // executes the following mapping:
-< //
-< // Both genotypes hom minor -> 0
-< // Hom minor + het -> 2
-< // Hom minor + hom major -> 3
-< // Het + het -> 4
-< // Het + hom major -> 5
-< // Hom major + hom major -> 6
-< // Either genotype missing -> 7
-< //
-< // Construction of the corresponding lookup table is deferred to
-< // domult_increment_lookup().
-<
-< int j, n, g, t;
-< double pmean, yfancy;
-< int c0, c1, nmiss;
-<
-< c0 = c1 = 0;
-< n = cupt->ngtypes;
-< if (n < nrows) {
-< fatalx("bad snp: %s %d\n", cupt->ID, n);
-< }
-< getrawcol(rawcol, cupt, xindex, nrows);
-< nmiss = 0;
-< for (j=0; j<nrows; ++j) {
-< g = rawcol[j];
-< if (g<0) {
-< ++nmiss;
-< continue;
-< }
-< c0 += g;
-< c1 += 2-g;
-< }
-< // instead of storing an entire column of floating point values,
-< t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
-< if (t < -99) {
-< if (xmean != NULL) {
-< xmean[col] = 0.0;
-< xfancy[col] = 0.0;
-< }
-< vzero(xcol, 3);
-< if (n0 != NULL) {
-< *n0 = -1;
-< *n1 = -1;
-< }
-< return -1;
-< }
-< vst(xcol, xcol, yfancy, 3);
-< if (xmean != NULL) {
-< xmean[col] = pmean*yfancy;
-< xfancy[col] = yfancy;
-< }
-< if (n0 != NULL) {
-< *n0 = c0 ;
-< *n1 = c1 ;
-< }
-< return nmiss ;
-< }
-<
----
-> /** this is the code to parallelize */
-2552,2553c2201
-< getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
-< uint32_t xblock, uint32_t nrows)
----
-> domult(double *tvecs, double *tblock, int numrow, int len)
-2555,2764c2203,2209
-< // slightly better to position at 0-3-6-9-12-16-19... instead of
-< // 0-3-6-9-12-15-18...
-< uint32_t shift_val = (xblock * 3) + (xblock / 5);
-<
-< uintptr_t bitfield_or[3];
-< uint32_t row_idx;
-< int cur_geno;
-< bitfield_or[0] = ((uintptr_t)7) << shift_val;
-< bitfield_or[1] = ((uintptr_t)2) << shift_val;
-< bitfield_or[2] = ((uintptr_t)3) << shift_val;
-< for (row_idx = 0; row_idx < nrows; row_idx++) {
-< cur_geno = *rawcol++;
-< if (cur_geno) {
-< if (cur_geno > 0) {
-< binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
-< } else {
-< binary_mmask[row_idx] |= bitfield_or[0];
-< }
-< }
-< }
-< }
-<
-< void
-< join_threads(pthread_t* threads, uint32_t ctp1)
-< {
-< if (!(--ctp1)) {
-< return;
-< }
-< #if _WIN32
-< WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
-< #else
-< uint32_t uii;
-< for (uii = 0; uii < ctp1; uii++) {
-< pthread_join(threads[uii], NULL);
-< }
-< #endif
-< }
-<
-< #if _WIN32
-< int32_t
-< spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
-< #else
-< int32_t
-< spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
-< #endif
-< {
-< uintptr_t ulii;
-< if (ct == 1) {
-< return 0;
-< }
-< for (ulii = 1; ulii < ct; ulii++) {
-< #if _WIN32
-< threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
-< if (!threads[ulii - 1]) {
-< join_threads(threads, ulii);
-< return -1;
-< }
-< #else
-< if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
-< join_threads(threads, ulii);
-< return -1;
-< }
-< #endif
-< }
-< return 0;
-< }
-<
-< THREAD_RET_TYPE block_increment_binary(void* arg) {
-< uintptr_t tidx = (uintptr_t)arg;
-< uintptr_t cur_indiv_idx = g_thread_start[tidx];
-< uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
-< uintptr_t* binary_cols = g_binary_cols;
-< uintptr_t* binary_mmask = g_binary_mmask;
-< double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
-< double* weights0 = g_weights;
-< double* weights1 = &(g_weights[32768]);
-< #ifdef __LP64__
-< double* weights2 = &(g_weights[65536]);
-< double* weights3 = &(g_weights[98304]);
-< #endif
-< uintptr_t* geno_ptr;
-< uintptr_t* mmask_ptr;
-< uintptr_t base_geno;
-< uintptr_t base_mmask;
-< uintptr_t final_geno;
-< uintptr_t indiv_idx2;
-< for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
-< geno_ptr = binary_cols;
-< base_geno = binary_cols[cur_indiv_idx];
-< mmask_ptr = binary_mmask;
-< base_mmask = binary_mmask[cur_indiv_idx];
-< if (!base_mmask) {
-< // special case: current individual has no missing genotypes in block
-< for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
-< final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
-< #ifdef __LP64__
-< *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-< #else
-< *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-< #endif
-< write_ptr++;
-< }
-< } else {
-< for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
-< final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
-< #ifdef __LP64__
-< *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-< #else
-< *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-< #endif
-< write_ptr++;
-< }
-< }
-< }
-< THREAD_RETURN;
-< }
-<
-< void
-< domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
-< {
-< // PLINK 1.5 partial sum lookup algorithm
-< double increments[40];
-< double* dptr;
-< double* dptr2;
-< uint32_t uii;
-< uint32_t ujj;
-< uint32_t ukk;
-< uint32_t umm;
-< uint32_t unn;
-< uint32_t uoo;
-< double partial_incr1;
-< double partial_incr2;
-< double partial_incr3;
-< double partial_incr4;
-< uintptr_t ulii;
-<
-< // populate lookup buffer
-< #ifdef __LP64__
-< for (uii = 0; uii < 20; uii += 5)
-< #else
-< for (uii = 0; uii < 10; uii += 5)
-< #endif
-< {
-< dptr = increments;
-< for (ujj = 0; ujj < 5; ujj++) {
-< dptr2 = &(tblock[(uii + ujj) * 3]);
-< *dptr++ = dptr2[0] * dptr2[0];
-< *dptr++ = 0;
-< *dptr++ = dptr2[0] * dptr2[1];
-< *dptr++ = dptr2[0] * dptr2[2];
-< *dptr++ = dptr2[1] * dptr2[1];
-< *dptr++ = dptr2[1] * dptr2[2];
-< *dptr++ = dptr2[2] * dptr2[2];
-< *dptr++ = 0;
-< }
-< dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
-< for (ujj = 0; ujj < 8; ujj++) {
-< partial_incr1 = increments[ujj + 32];
-< for (ukk = 0; ukk < 8; ukk++) {
-< partial_incr2 = partial_incr1 + increments[ukk + 24];
-< for (umm = 0; umm < 8; umm++) {
-< partial_incr3 = partial_incr2 + increments[umm + 16];
-< for (unn = 0; unn < 8; unn++) {
-< partial_incr4 = partial_incr3 + increments[unn + 8];
-< for (uoo = 0; uoo < 8; uoo++) {
-< *dptr++ = partial_incr4 + increments[uoo];
-< }
-< }
-< }
-< }
-< }
-< }
-< g_XTX_lower_tri = XTX_lower_tri;
-< g_weights = partial_sum_lookup_buf;
-< g_binary_cols = binary_cols;
-< g_binary_mmask = binary_mmask;
-< if (spawn_threads(threads, block_increment_binary, thread_ct)) {
-< fatalx("Error: Failed to create thread.\n");
-< return;
-< }
-< ulii = 0;
-< block_increment_binary((void*)ulii);
-< join_threads(threads, thread_ct);
-< }
-<
-< THREAD_RET_TYPE block_increment_normal(void* arg) {
-< uintptr_t tidx = (uintptr_t)arg;
-< uintptr_t start_indiv_idx = g_thread_start[tidx];
-< uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
-< uintptr_t indiv_ct = g_indiv_ct;
-< uint32_t block_size = g_block_size;
-< double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
-< double* write_ptr;
-< double* tblock;
-< double* tblock_read_ptr;
-< double cur_tblock_val;
-< uintptr_t cur_indiv_idx;
-< uintptr_t indiv_idx2;
-< uint32_t bidx;
-< for (bidx = 0; bidx < block_size; bidx++) {
-< write_ptr = write_start_ptr;
-< tblock = &(g_tblock[bidx * indiv_ct]);
-< for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
-< cur_tblock_val = tblock[cur_indiv_idx];
-< tblock_read_ptr = tblock;
-< for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
-< *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
-< write_ptr++;
-< }
-< }
----
-> int i ;
-> double ycheck ;
-> vzero(tvecs, len*len) ;
-> for (i=0; i<numrow; i++) {
-> ycheck = asum(tblock+i*len, len) ;
-> if (fabs(ycheck)>.00001) fatalx("bad ycheck\n") ;
-> addoutersym(tvecs, tblock+i*len, len) ;
-2766d2210
-< THREAD_RETURN;
-2768,2798d2211
-<
-< void
-< domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
-< {
-< // General case: tblock[] can have an arbitrary number of distinct values, so
-< // can't use bit hacks.
-< //
-< // This multithreaded implementation is pretty far from optimal; if more
-< // speed is needed, use the DGEMM function from a vendor-optimized BLAS.
-< // (Sum of k outer products is just equal to the product of a n*k and a k*n
-< // matrix.)
-< int ii;
-< double ycheck;
-< uintptr_t ulii;
-< for (ii=0; ii<block_size; ii++) {
-< ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
-< if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
-< }
-< g_XTX_lower_tri = XTX_lower_tri;
-< g_tblock = tblock;
-< g_block_size = block_size;
-< g_indiv_ct = indiv_ct;
-< if (spawn_threads(threads, block_increment_normal, thread_ct)) {
-< fatalx("Error: Failed to create thread.\n");
-< return;
-< }
-< ulii = 0;
-< block_increment_normal((void*)ulii);
-< join_threads(threads, thread_ct);
-< }
-<
-2804,2805c2217,2219
-< int n ;
-< double pmean, yfancy ;
----
-> Indiv *indx ;
-> int j, n, g, t ;
-> double y, pmean, p, yfancy ;
-2832c2246
-< void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
----
-> double doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
-2835a2250
-> int t1, t2 ;
-2836a2252
-> double y, sd ;
-2898c2314
-< // Indiv *indx ;
----
-> Indiv *indx ;
-2906c2322
-< // indx = indivmarkers[i] ;
----
-> indx = indivmarkers[i] ;
-2930c2346
-< dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
----
-> dumpgrmbin(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-2932c2348
-< int a, b;
----
-> int a, b, s, xa, xb, maxs ;
-2933a2350
-> FILE *fff ;
-2936c2353
-< int wout, numout, fdes, ret = 0 ;
----
-> int wout, numout, fdes, ret ;
-2984c2401,2403
-< y = XTX[a*nrows+b] / y_norm; // bugfix
----
-> xa = xindex[a] ;
-> xb = xindex[b] ;
-> y = XTX[xa*nrows+xb] / y_norm;
-2994c2413
-< int a, b;
----
-> int a, b, s, xa, xb, maxs ;
-3005c2424
-< dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
----
-> dumpgrmbin(XTX, xindex, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
-3010c2429
-< double y_norm_recip ;
----
-> double y_norm ;
-3014c2433
-< y_norm_recip = ((double)nrows) / asum(d,nrows);
----
-> y_norm = asum(d,nrows) / (double) nrows ;
-3020c2439,2441
-< y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
----
-> xa = xindex[a] ;
-> xb = xindex[b] ;
-> y = XTX[xa*nrows+xb] ;
-3023c2444
-< fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
----
-> fprintf(fff, "%0.6f\n", y/y_norm) ;
diff --git a/src/eigensrc/qq2.c b/src/eigensrc/qq2.c
deleted file mode 100644
index 5d7afb9..0000000
--- a/src/eigensrc/qq2.c
+++ /dev/null
@@ -1,29 +0,0 @@
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- double *t_gsource_pass_fm;
- ZALLOC(t_gsource_pass_fm, rsize_pass*n, double);
- int fm, fma;
- for(fm = 0; fm < n; fm++){
- for(fma = 0; fma < rsize_pass; fma++){
- t_gsource_pass_fm[fm*rsize_pass+fma] = t_gsource_pass[fm*rsize+fma];
- }
- }
-
- double *gsource_pass_fm;
- ZALLOC(gsource_pass_fm, n*rsize_pass, double);
- for(fm = 0; fm < rsize_pass; fm++){
- for(fma = 0; fma < n; fma++){
- gsource_pass_fm[fm*n+fma] = gsource_pass[fm*n+fma];
- }
- }
-
- regressit(regans, t_gsource_pass_fm, gtarget, n, rsize_pass) ; //run regression
- mulmat(www, regans, gsource_pass_fm, 1, rsize_pass, n) ; //multiply regans and gsource_pass
- free(t_gsource_pass_fm);
- free(gsource_pass_fm);
-// regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ; //run regression
-// mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ; //multiply regans and gsource_pass
- /* End of fix */
-
-
diff --git a/src/eigensrc/qqq.c b/src/eigensrc/qqq.c
deleted file mode 100644
index 2f51527..0000000
--- a/src/eigensrc/qqq.c
+++ /dev/null
@@ -1,3139 +0,0 @@
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <math.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <stdint.h>
-#include <inttypes.h>
-
-#include <nicklib.h>
-#include <getpars.h>
-
-#include "badpairs.h"
-#include "admutils.h"
-#include "mcio.h"
-#include "mcmcpars.h"
-#include "eigsubs.h"
-#include "egsubs.h"
-#include "qpsubs.h"
-#include "smartsubs.h"
-#include "exclude.h"
-#include "globals.h"
-
-/**
- Most of this code written by Nick Patterson
- (Broad institute and Harvard Medical)
- Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
-
- Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
-
-#define WVERSION "12010"
-/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
-
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
-
-SNPs discarded if no data.
-Phylipfile now supported
-
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
-
-output capability added (like convertf)
-
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
-
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
-
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
-
-writesnpeig added
-
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
-
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
-
-fst on X
-fst std errors now fixed
-
-bad bug fixed (outfiles changed indivmarkers) ...
-
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
-
-bad bug fix. xtypes not allocated correctly
-
-version compatible with Mac
-XTX.dbg commented out
-
-outliermode added
-
-regmode added
-maxpops parametric. Use easymode if large
-
-id2pops added
-
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-*/
-
-#if _WIN32
-// just in case we try a Windows port in the future
-#include <windows.h>
-#include <process.h>
-#define pthread_t HANDLE
-#define THREAD_RET_TYPE unsigned __stdcall
-#define THREAD_RETURN return 0
-#define MAX_THREADS 63
-#define MAX_THREADS_P1 64
-#else
-#include <pthread.h>
-#define THREAD_RET_TYPE void*
-#define THREAD_RETURN return NULL
-#define MAX_THREADS 127
-#define MAX_THREADS_P1 128
-#endif
-
-#define MAXFL 50
-#define MAXSTR 512
-#define MAXPOPS 1000
-
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
-Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
-
-double nhwfilter = -1.0;
-
-int thread_ct_config = 0;
-
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
-
-int xchrom = -1 ;
-// list of outliers
-
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
-
-int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
-
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-void dofast(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int numeigs, FILE *ofile) ;
-
-uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
-{
- // return smallest integer vv for which (vv * (vv + modif)) is no smaller
- // than cur_prod, and neither term in the product is negative. (Note the
- // lack of a divide by two; cur_prod should also be double its "true" value
- // as a result.)
- int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
- }
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
- return vv;
-}
-
-void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
-{
- int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
-}
-
-// set align to 1 for no alignment
-void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
-{
- int32_t modif = 1 - start * 2;
- uint32_t cur_piece = 1;
- int64_t ct_tr;
- int64_t cur_prod;
- int32_t lbound;
- int32_t ubound;
- uint32_t uii;
- uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
- // x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
- align *= 2;
- align_m1 = align - 1;
- target_arr[0] = lbound;
- target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
-}
-
-void
-symit2(double* XTX, uintptr_t nrows)
-{
- // unpacks LOWER-triangle-only symmetric matrix representation into regular
- // square matrix.
- uintptr_t row_idx;
- uintptr_t col_idx;
- double* read_col;
- double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
- return;
- }
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
- }
- }
-}
-
-void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
-{
- uintptr_t new_row_idx;
- uintptr_t new_col_idx;
- double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
- }
- }
-}
-
-// make these file scope so multithreading works
-static double* g_XTX_lower_tri;
-static double* g_tblock;
-static uint32_t g_block_size;
-static uintptr_t g_indiv_ct;
-static uint32_t g_thread_start[MAX_THREADS_P1];
-
-static double* g_weights;
-static uintptr_t* g_binary_cols;
-static uintptr_t* g_binary_mmask;
-
-int main(int argc, char **argv)
-{
-
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww ;
- double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
- int blocksize = 1024;
- double *tblock = NULL;
- int* binary_rawcol = NULL;
- uintptr_t* binary_cols = NULL;
- uintptr_t* binary_mmask = NULL;
-
- OUTLINFO *outpt ;
-
- pthread_t threads[MAX_THREADS];
- uint32_t thread_ct;
-
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fastmode) {
- printf("fastmode => easymode\n") ;
- easymode = YES ;
- }
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
-
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
-
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
-
- nostatslim = MAX(nostatslim, 3) ;
-
- outlfile = ofile = stdout;
-
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
-
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
-
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
-
- numindivs = getindivs(indivname, &indivmarkers) ;
-
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
-
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
-
-
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
-
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
-
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
- }
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
- }
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
- }
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
- }
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
- {
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
- }
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
-
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
-
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
-
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
-
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
-
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
-
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
-
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
-
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
-
-
- /* Load non-ignored individuals into xindlist,xindex:
- * xindex[i] = index into indivmarkers
- * xindlist[i] = pointer to Indiv struct */
-
- ZALLOC(xtypes, numindivs, int) ;
-
-
-
- /* Load non-ignored SNPs into xsnplist:
- * xsnplist[i] = pointer to SNP struct */
-
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
-
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
-
- if (fastmode) {
-
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
-
-// dofastx(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols, ofile) ;
- dofast(xsnplist, xindlist, ncols, nrows, numeigs, ofile) ;
-
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
-
-
- }
-
- /* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
-#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
-#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
-#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
-
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
-
- blocksize = MIN(blocksize, ncols) ;
-
- // xfancy is multiplier for column xmean is mean to take off
- // badlist is list of rows to delete (outlier removal)
-
- numoutiter = 1 ;
-
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
-
- // try to autodetect number of (virtual) processors, and use that number to
- // set the thread count. allow the user to override this in the future
-#if _WIN32
- SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
-#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
- }
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
- }
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
- }
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
- }
-
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
-
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
-
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
-
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
-
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
-
- ++xblock ;
- ++nused ;
-
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
-
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
-
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
-
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
-
- eigvecs(XTX, lambda, evecs, nrows) ;
-// eigenvalues are in decreasing order
-
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
-
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
-
- m = numgtz(lambda, nrows) ;
- /* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
-
- /* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
- else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
- }
- /* END of code to print Tracy-Widom statistics */
- }
-
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
-// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
-
- /* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
- /* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
- /* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
- /* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
- }
- fclose(ovfile) ;
- }
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
-
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
-
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
- }
- }
-
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
-
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
-
- for (i=0; i<nrows; i++) {
-
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
-
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
-
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
-
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
-
-
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
-
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
-
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
-
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
-
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
-
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
-
-
-
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
-
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
-
-
-// output files
- settersemode(YES) ;
-
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
-
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
-
-
- if (numeg==1) dotpopsmode = NO ;
-
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
-
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
-
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
-
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- }
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
- }
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
- }
- fclose(phylipfile) ;
- }
-
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
- }
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
- }
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
-
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
-
- printxcorr(XTX, nrows, xindlist) ;
-
-
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
-
- printf("##end of smartpca run\n") ;
- return 0 ;
-}
-
-void readcommands(int argc, char **argv)
-
-{
- int i ;
- phandle *ph ;
- int t ;
-
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
-
-}
-
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
-/* take off mean force missing to zero */
-/* set up fancy norming */
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
-}
-
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
-{
- double p, ynum, ysum, y, ymean, yfancy = 1.0;
-
- if (n == nmiss) {
- return -999;
- }
- ynum = n - nmiss;
- ysum = c0;
- ymean = ysum / ynum;
- cc[0] = -ymean;
- cc[1] = 1.0 - ymean;
- cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
- }
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
- }
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
- return nmiss;
-}
-
-double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
-// vec will always have mean 0
-// perhaps should rewrite to put xa1 etc in arrays
-{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
-
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
- }
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
- }
- ++ncall ;
-
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
- }
-
-
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
- }
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
-}
-double anova(double *vec, int len, int *xtypes, int numeg)
-// anova 1 but f statistic
-{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
-
- static int ncall2 = 0 ;
-
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
-// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ftail ;
-
-}
-double anova1(double *vec, int len, int *xtypes, int numeg)
-{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
- }
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
- }
-
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
-
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
-
- return ylike ;
-
-}
-void publishit(char *sss, int df, double chi)
-{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
-
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
-}
-
-void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
-{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
-// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
-
- free(pp) ;
- free(npp) ;
-
-}
-void printxcorr(double *X, int nrows, Indiv **indxx)
-{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
-
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
-
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
-
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
-
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
-
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
-
- }
- }
-}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
-{
-
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
-
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
-
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
-
- *pnumld = numld ;
- return ;
-}
-
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
-{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
-
- // Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
-
- int i,ii;
-
- // Compute correlation to previous SNPs
- double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
- }
- }
-
- // Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ;
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ;
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
-
-
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
-
- if ( qtmode == YES ) {
- return;
- }
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
-
-}
-void fixwt(SNP **snpm, int nsnp, double val)
-{
- int k ;
- SNP *cupt ;
-
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
-
-}
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- return z + zz ;
-
-}
-
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
-// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
- }
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
-
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
-
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
-
-}
-
-void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
-{
-// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
-
-
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
-// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
-
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
-
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
-
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
-
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
-
- fclose(fff) ;
-
-}
-
-/* load genotype data for this SNP into rawcol (call this g[])
- * in fvadjust:
- * ymean := mean over all non-missing g[i]
- * xcol[i] -= ymean if g[i] is not missing
- * xcol[i] = 0.0 if g[i] is missing
- * if (fancynorm == NO)
- * yfancy = 1.0
- * if (fancynorm == YES and altnormstyle == NO)
- * yfancy = (ymean/2)*(1-(ymean/2))
- * if (fancynorm == YES and altnormstyle == YES)
- * yfancy = ( sum(g[i])+1 ) / ( 2*N + 2 )
- * for (sum,N) only over non-missing g[i]
- * back in getcolxz:
- * on exit:
- * xmean[ s ] = ymean * yfancy
- * xfancy[ s ] = yfancy
- * *n0 = sum( g[i] ) non-missing g[i] only
- * *n1 = sum( 2-g[i] ) non-missing g[i] only
- * g[i] set to zero where missing data
- * */
-
-
-int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
-// side effect set xmean xfancy and count variant and reference alleles
-// returns missings after fill in
-{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
-
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
-}
-
-int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
-{
- // Modified getcolxz() which converts to a 3-bit-per-genotype representation
- // compatible with PLINK 1.5's partial sum lookup outer product algorithm.
- // (Well, to be more precise, the conversion occurs in getcolxz_binary2();
- // this function handles the other duties of getcolxz().) Assumes
- // usepopsformissing is NOT set, and ldregress is zero.
- //
- // Main genotype array:
- // Homozygous minor -> 0
- // Heterozygous -> 2
- // Homozygous major -> 3
- // Missing -> 0
- //
- // Missing mask:
- // Nonmissing -> 0
- // Missing -> 7
- //
- // Suppose person 1 has genotype g_1 and missing mask m_1, and person 2 has
- // genotype g_2 and missing mask m_2. Then, the operation
- //
- // (g_1 + g_2) | m_1 | m_2
- //
- // executes the following mapping:
- //
- // Both genotypes hom minor -> 0
- // Hom minor + het -> 2
- // Hom minor + hom major -> 3
- // Het + het -> 4
- // Het + hom major -> 5
- // Hom major + hom major -> 6
- // Either genotype missing -> 7
- //
- // Construction of the corresponding lookup table is deferred to
- // domult_increment_lookup().
-
- int j, n, g, t;
- double pmean, yfancy;
- int c0, c1, nmiss;
-
- c0 = c1 = 0;
- n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
- nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
- // instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
-}
-
-void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
-{
- // slightly better to position at 0-3-6-9-12-16-19... instead of
- // 0-3-6-9-12-15-18...
- uint32_t shift_val = (xblock * 3) + (xblock / 5);
-
- uintptr_t bitfield_or[3];
- uint32_t row_idx;
- int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
- }
- }
-}
-
-void
-join_threads(pthread_t* threads, uint32_t ctp1)
-{
- if (!(--ctp1)) {
- return;
- }
-#if _WIN32
- WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
-#else
- uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
-#endif
-}
-
-#if _WIN32
-int32_t
-spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
-#else
-int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
-#endif
-{
- uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
- }
-#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
-#endif
- }
- return 0;
-}
-
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
-#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
-#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
-#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
-#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
-#endif
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
-{
- // PLINK 1.5 partial sum lookup algorithm
- double increments[40];
- double* dptr;
- double* dptr2;
- uint32_t uii;
- uint32_t ujj;
- uint32_t ukk;
- uint32_t umm;
- uint32_t unn;
- uint32_t uoo;
- double partial_incr1;
- double partial_incr2;
- double partial_incr3;
- double partial_incr4;
- uintptr_t ulii;
-
- // populate lookup buffer
-#ifdef __LP64__
- for (uii = 0; uii < 20; uii += 5)
-#else
- for (uii = 0; uii < 10; uii += 5)
-#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
- }
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_weights = partial_sum_lookup_buf;
- g_binary_cols = binary_cols;
- g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
- }
- }
- }
- THREAD_RETURN;
-}
-
-void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
-{
- // General case: tblock[] can have an arbitrary number of distinct values, so
- // can't use bit hacks.
- //
- // This multithreaded implementation is pretty far from optimal; if more
- // speed is needed, use the DGEMM function from a vendor-optimized BLAS.
- // (Sum of k outer products is just equal to the product of a n*k and a k*n
- // matrix.)
- int ii;
- double ycheck;
- uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
- g_XTX_lower_tri = XTX_lower_tri;
- g_tblock = tblock;
- g_block_size = block_size;
- g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
- ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
-}
-
-void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
-// side effect set xmean xfancy
-{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
-
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
-
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
-
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
-}
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
-{
-
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
-
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
-
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
-
-
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
-
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
-
-}
-
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
-// extracted from dotttest ;
-{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
-
-
- calcmean(w0, vec, len, xtypes, numeg) ;
-
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
-
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
- }
-
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
-
-}
-
-void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
-{
-
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
-
- ++ncall ;
-
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
-// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
-
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
-}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
-{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
-}
-void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
-// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
-
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
- if (verbose)
- printf("file %s opened\n", sss) ;
-
- // Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
-}
-void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
-{
- int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
-
- // Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
-
-}
-void
-dofast(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int numeigs, FILE *ofile)
-{
- double *eigenvals ;
- double *eigenvecs ;
- double *fvecs, *ww ;
-
- int nrows = numindivs, ncols=numsnps ;
- int i, j ;
- double y, *xpt ;
- Indiv *indx ;
-
- ZALLOC(eigenvals, numeigs, double) ;
- ZALLOC(eigenvecs, numeigs*nrows, double) ;
-
- kjg_fastpca(numsnps, numindivs,
- numeigs, 2*numeigs, numeigs,
- eigenvals, eigenvecs);
-
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- transpose(eigenvecs, eigenvecs, nrows, numeigs) ; // old smartpca convention
- for (i=0; i < nrows ; i++) {
- indx = indivmarkers[i] ;
- printf("zzz: %20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = eigenvecs[j*nrows+i] ;
- printf("%10.4f ", y) ;
- }
- printf("%15s\n", indx -> egroup) ;
- }
- ZALLOC(fvecs, numeigs*ncols, double) ;
- for (j=0; j<numeigs; j++) {
-
-
-
- }
-
- for (i=0; i < nrows ; i++) {
- indx = indivmarkers[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = eigenvecs[j*nrows+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
-
- fclose(ofile) ;
-/**
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
- }
-
-*/
-
- free(eigenvecs) ;
- free(eigenvals) ;
-
-}
diff --git a/src/eigensrc/smarteigenstrat.c b/src/eigensrc/smarteigenstrat.c
index 067e70b..8a1f108 100644
--- a/src/eigensrc/smarteigenstrat.c
+++ b/src/eigensrc/smarteigenstrat.c
@@ -17,89 +17,94 @@
#define WVERSION "1000"
-
#define MAXFL 50
#define MAXSTR 512
#define MAXSIZE 8.0e9
-typedef enum outputmodetype inputmodetype;
+typedef enum outputmodetype inputmodetype;
-extern int packmode ;
-extern int malexhet ;
-extern int verbose ;
-extern int plotmode ;
+extern int packmode;
+extern int malexhet;
+extern int verbose;
+extern int plotmode;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
/* major data structures */
Indiv **indivmarkers;
-SNP **snpmarkers ;
-int numsnps, numindivs ;
-
-char *genotypename = NULL ; /* name of genotype file */
-char *snpname = NULL ; /* name of SNP file */
-char *indivname = NULL ; /* name of sample file */
-char *pcaname = NULL ; /* name of pca file */
-char *imode = "eigenstrat"; /* input mode */
-char *outputname = NULL ; /* name of output file */
-int numpc = 10; /* number of principal components
- to correct */
+SNP **snpmarkers;
+int numsnps, numindivs;
+
+char *genotypename = NULL; /* name of genotype file */
+char *snpname = NULL; /* name of SNP file */
+char *indivname = NULL; /* name of sample file */
+char *pcaname = NULL; /* name of pca file */
+char *imode = "eigenstrat"; /* input mode */
+char *outputname = NULL; /* name of output file */
+int numpc = 10; /* number of principal components
+ to correct */
/*
- If these are to be global, remove them from function parameter lists.
- If they're going to be local, put the rest in (chisq routines)
-*/
+ If these are to be global, remove them from function parameter lists.
+ If they're going to be local, put the rest in (chisq routines)
+ */
int NSAMPLES;
int *outlier;
int L;
inputmodetype inmode;
-FILE *fpout; /* output file */
-
-void readcommands(int argc, char **argv) ;
-void setinmode(inputmodetype *inmode, char *imode);
-void readpcafile(double **Vp, int **outlierp, int *kp, int L, int NSAMPLES);
-void getphenos(int NSAMPLES, double **iscasep, int *outlier,
- double **iscasecorrp, int L, double *V);
-double compute_chisq(double *source, double *target);
-double compute_chisqE(double *source, double *target);
-
-
-int main(int argc, char **argv)
+FILE *fpout; /* output file */
+
+void
+readcommands (int argc, char **argv);
+void
+setinmode (inputmodetype *inmode, char *imode);
+void
+readpcafile (double **Vp, int **outlierp, int *kp, int L, int NSAMPLES);
+void
+getphenos (int NSAMPLES, double **iscasep, int *outlier, double **iscasecorrp,
+ int L, double *V);
+double
+compute_chisq (double *source, double *target);
+double
+compute_chisqE (double *source, double *target);
+
+int
+main (int argc, char **argv)
{
double *V;
double *xx;
double *iscase;
double *iscasecorr;
int K;
- int k,m,n;
+ int k, m, n;
int nignore;
double rowsum, rowsum1;
double chisq, Echisq, gamma, denom;
- readcommands(argc, argv) ;
- if (outputname != NULL)
- openit(outputname, &fpout, "w") ;
- else
+ readcommands (argc, argv);
+ if (outputname != NULL)
+ openit (outputname, &fpout, "w");
+ else
fpout = stdout;
- fprintf(fpout, "Chisq EIGENSTRAT\n");
+ fprintf (fpout, "Chisq EIGENSTRAT\n");
- setinmode(&inmode, imode);
+ setinmode (&inmode, imode);
packmode = YES;
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, NULL, &nignore, 1) ;
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, NULL, &nignore, 1);
- NSAMPLES = getindivs(indivname, &indivmarkers) ;
+ NSAMPLES = getindivs (indivname, &indivmarkers);
- setstatus(indivmarkers, NSAMPLES, "Case") ;
- setgenotypename(&genotypename, indivname) ;
- if (genotypename != NULL) {
- getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, NSAMPLES, nignore) ;
- }
+ setstatus (indivmarkers, NSAMPLES, "Case");
+ setgenotypename (&genotypename, indivname);
+ if (genotypename != NULL)
+ {
+ getgenos (genotypename, snpmarkers, indivmarkers, numsnps, NSAMPLES,
+ nignore);
+ }
/*******************************************************************/
/* Free memory: Usually this is done in outfiles: */
@@ -110,399 +115,499 @@ int main(int argc, char **argv)
/*******************************************************************/
L = numpc;
- readpcafile(&V, &outlier, &K, L, NSAMPLES);
- getphenos(NSAMPLES, &iscase, outlier, &iscasecorr, L, V);
+ readpcafile (&V, &outlier, &K, L, NSAMPLES);
+ getphenos (NSAMPLES, &iscase, outlier, &iscasecorr, L, V);
/* main eigenstrat loop here */
- if ((xx = (double *)malloc(NSAMPLES*sizeof(*xx))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
-
- for(m=0;m<numsnps;m++) {
-
- SNP *cupt = snpmarkers[m];
- for(n=0; n<NSAMPLES; n++)
+ if ((xx = (double *) malloc (NSAMPLES * sizeof(*xx))) == NULL)
{
- int j = getgtypes(cupt,n);
-
- if(j == 0) { xx[n] = 0.0; }
- else if(j == 1) { xx[n] = 0.5; }
- else if(j == 2 ) { xx[n] = 1.0; }
- else if(j == -1) { xx[n] = -100.0; }
-
- if(outlier[n] == 1) xx[n] = -100.0;
-
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- /* mean-adjust xx */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ for (m = 0; m < numsnps; m++)
{
- if(qtmode == NO && ((outlier[n]) || (xx[n] < -99.0))) continue;
- if(qtmode == YES && ((outlier[n]) || (xx[n] == -100.0))) continue;
- rowsum += xx[n];
- rowsum1 += 1.0;
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(qtmode == NO) {
- if (xx[n] < -99.0)
- xx[n] = -100.0; /* still keep track */
- else
- xx[n] -= rowsum/rowsum1;
- }
- else {
- if (xx[n] == -100.0)
- xx[n] = -100.0; /* still keep track */
- else
- xx[n] -= rowsum/rowsum1;
- }
- }
-
- /* Chisq */
- chisq = compute_chisq(xx,iscase);
- /* EIGENSTRAT */
- for(k=0; k<L; k++)
- {
- gamma = 0.0;
- denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(qtmode == NO && (outlier[n] || xx[n] < -99.0)) continue;
- if(qtmode == YES && (outlier[n] || xx[n] == -100.0)) continue;
- gamma += xx[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
- }
- gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
- {
- if(qtmode == NO && (outlier[n] || xx[n] < -99.0)) continue;
- if(qtmode == YES && (outlier[n] || xx[n] == -100.0)) continue;
- xx[n] -= gamma*V[NSAMPLES*n+k];
- }
- }
- Echisq = compute_chisqE(xx,iscasecorr);
-
- if(rowsum1 == 0.0)
- {
- chisq = -1.0; Echisq = -1.0;
- }
-
- if(chisq >= 0.0) fprintf(fpout,"%.04f",chisq);
- else fprintf(fpout,"NA");
- if(Echisq >= 0.0) fprintf(fpout," %.04f\n",Echisq);
- else fprintf(fpout," NA\n");
-
- if(NSAMPLES*m > MAXSIZE)
- {
- fprintf(stderr,"OOPS genotype file has > %g genotypes\n",MAXSIZE);
- fprintf(fpout,"OOPS genotype file has > %g genotypes\n",MAXSIZE);
- exit(1);
+ SNP *cupt = snpmarkers[m];
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ int j = getgtypes (cupt, n);
+
+ if (j == 0)
+ {
+ xx[n] = 0.0;
+ }
+ else if (j == 1)
+ {
+ xx[n] = 0.5;
+ }
+ else if (j == 2)
+ {
+ xx[n] = 1.0;
+ }
+ else if (j == -1)
+ {
+ xx[n] = -100.0;
+ }
+
+ if (outlier[n] == 1)
+ xx[n] = -100.0;
+
+ }
+
+ /* mean-adjust xx */
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO && ((outlier[n]) || (xx[n] < -99.0)))
+ continue;
+ if (qtmode == YES && ((outlier[n]) || (xx[n] == -100.0)))
+ continue;
+ rowsum += xx[n];
+ rowsum1 += 1.0;
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (qtmode == NO)
+ {
+ if (xx[n] < -99.0)
+ xx[n] = -100.0; /* still keep track */
+ else
+ xx[n] -= rowsum / rowsum1;
+ }
+ else
+ {
+ if (xx[n] == -100.0)
+ xx[n] = -100.0; /* still keep track */
+ else
+ xx[n] -= rowsum / rowsum1;
+ }
+ }
+
+ /* Chisq */
+ chisq = compute_chisq (xx, iscase);
+
+ /* EIGENSTRAT */
+ for (k = 0; k < L; k++)
+ {
+ gamma = 0.0;
+ denom = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO && (outlier[n] || xx[n] < -99.0))
+ continue;
+ if (qtmode == YES && (outlier[n] || xx[n] == -100.0))
+ continue;
+ gamma += xx[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
+ gamma /= denom;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO && (outlier[n] || xx[n] < -99.0))
+ continue;
+ if (qtmode == YES && (outlier[n] || xx[n] == -100.0))
+ continue;
+ xx[n] -= gamma * V[NSAMPLES * n + k];
+ }
+ }
+ Echisq = compute_chisqE (xx, iscasecorr);
+
+ if (rowsum1 == 0.0)
+ {
+ chisq = -1.0;
+ Echisq = -1.0;
+ }
+
+ if (chisq >= 0.0)
+ fprintf (fpout, "%.04f", chisq);
+ else
+ fprintf (fpout, "NA");
+ if (Echisq >= 0.0)
+ fprintf (fpout, " %.04f\n", Echisq);
+ else
+ fprintf (fpout, " NA\n");
+
+ if (NSAMPLES * m > MAXSIZE)
+ {
+ fprintf (stderr, "OOPS genotype file has > %g genotypes\n", MAXSIZE);
+ fprintf (fpout, "OOPS genotype file has > %g genotypes\n", MAXSIZE);
+ exit (1);
+ }
}
- }
return 0;
}
-
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
int i;
- char *parname = NULL ;
- phandle *ph ;
+ char *parname = NULL;
+ phandle *ph;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
- getint(ph, "packmode:", &packmode) ; // controls internals
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "pcaname:", &pcaname) ;
- getint(ph, "numpc:", &numpc) ;
- getint(ph, "numeigs:", &numpc) ;
- getint(ph, "qtmode:", &qtmode) ;
- getint(ph, "hashcheck:", &hashcheck) ;
+ getint (ph, "packmode:", &packmode); // controls internals
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "pcaname:", &pcaname);
+ getint (ph, "numpc:", &numpc);
+ getint (ph, "numeigs:", &numpc);
+ getint (ph, "qtmode:", &qtmode);
+ getint (ph, "hashcheck:", &hashcheck);
- getstring(ph, "outputname:", &outputname);
+ getstring (ph, "outputname:", &outputname);
- writepars(ph) ;
- closepars(ph) ;
+ writepars (ph);
+ closepars (ph);
}
-
-void setinmode(inputmodetype *inmode, char *imode) {
- char *ss = strdup(imode);
- int len = strlen(ss);
+void
+setinmode (inputmodetype *inmode, char *imode)
+{
+ char *ss = strdup (imode);
+ int len = strlen (ss);
int i;
- for(i=0;i<len;i++) {
- ss[i] = tolower(ss[i]);
- }
+ for (i = 0; i < len; i++)
+ {
+ ss[i] = tolower(ss[i]);
+ }
- *inmode = EIGENSTRAT; /* default */
- if ( strcmp(ss, "eigenstrat") == 0 )
+ *inmode = EIGENSTRAT; /* default */
+ if (strcmp (ss, "eigenstrat") == 0)
*inmode = EIGENSTRAT;
- if ( strcmp(ss, "ped") == 0 )
+ if (strcmp (ss, "ped") == 0)
*inmode = PED;
- if ( strcmp(ss, "packedped") == 0 )
+ if (strcmp (ss, "packedped") == 0)
*inmode = PACKEDPED;
- if ( strcmp(ss, "ancestrymap") == 0 )
+ if (strcmp (ss, "ancestrymap") == 0)
*inmode = ANCESTRYMAP;
- if ( strcmp(ss, "packedancestrymap") == 0 )
+ if (strcmp (ss, "packedancestrymap") == 0)
*inmode = PACKEDANCESTRYMAP;
}
-void readpcafile(double **Vp, int **outlierp, int *kp, int L,
- int NSAMPLES) {
+void
+readpcafile (double **Vp, int **outlierp, int *kp, int L, int NSAMPLES)
+{
/* Build V[] and K and outlier[] */
- char *PCAFILE = strdup(pcaname);
+ char *PCAFILE = strdup (pcaname);
double tempdouble;
int K;
FILE *fppca;
double *V;
int *outlier;
int noutlier;
- int x,n,k;
-
- if ((V = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*V))) == NULL)
- { fprintf(stderr, "CM\n"); exit(1); }
- if ((outlier = (int *)malloc(NSAMPLES*sizeof(*outlier))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
-
-
- if( (fppca = fopen(PCAFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", PCAFILE);
- exit(1);
- }
-
- fscanf(fppca,"%d",&K);
- if(L > K)
- {
- fprintf(stderr,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- fprintf(fpout,"OOPS l=%d is larger than k=%d in %s\n",L,K,PCAFILE);
- exit(1);
- }
- for(x=0; x<K; x++) fscanf(fppca,"%lf",&tempdouble); /* eigenvalues */
- for(n=0; n<NSAMPLES; n++)
- {
- for(k=0; k<K; k++) fscanf(fppca,"%lf",&V[NSAMPLES*n+k]);
- if(feof(fppca))
+ int x, n, k;
+
+ if ((V = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*V))) == NULL)
{
- fprintf(stderr,"OOPS: %s contains less than %d times %d entries\n",
- PCAFILE,NSAMPLES,K);
- fprintf(fpout,"OOPS: %s contains less than %d times %d entries\n",
- PCAFILE,NSAMPLES,K);
- exit(1);
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((outlier = (int *) malloc (NSAMPLES * sizeof(*outlier))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- /* check for outliers */
- outlier[n] = 1;
- for(k=0; k<K; k++) { if(V[NSAMPLES*n+k] != 0.0) outlier[n] = 0; }
- if(outlier[n] == 1) noutlier++;
- }
- fscanf(fppca,"%lf",&tempdouble);
- if(!(feof(fppca)))
- {
- fprintf(stderr,"OOPS: %s contains too many entries\n",PCAFILE);
- fprintf(fpout,"OOPS: %s contains too many entries\n",PCAFILE);
- exit(1);
- }
- fclose(fppca);
+
+ if ((fppca = fopen (PCAFILE, "r")) == NULL)
+ {
+ fprintf (stderr, "Could not open input file %s\n", PCAFILE);
+ exit (1);
+ }
+
+ fscanf (fppca, "%d", &K);
+ if (L > K)
+ {
+ fprintf (stderr, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ fprintf (fpout, "OOPS l=%d is larger than k=%d in %s\n", L, K, PCAFILE);
+ exit (1);
+ }
+ for (x = 0; x < K; x++)
+ fscanf (fppca, "%lf", &tempdouble); /* eigenvalues */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ for (k = 0; k < K; k++)
+ fscanf (fppca, "%lf", &V[NSAMPLES * n + k]);
+ if (feof(fppca))
+ {
+ fprintf (stderr, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ fprintf (fpout, "OOPS: %s contains less than %d times %d entries\n",
+ PCAFILE, NSAMPLES, K);
+ exit (1);
+ }
+ /* check for outliers */
+ outlier[n] = 1;
+ for (k = 0; k < K; k++)
+ {
+ if (V[NSAMPLES * n + k] != 0.0)
+ outlier[n] = 0;
+ }
+ if (outlier[n] == 1)
+ noutlier++;
+ }
+ fscanf (fppca, "%lf", &tempdouble);
+ if (!(feof(fppca)))
+ {
+ fprintf (stderr, "OOPS: %s contains too many entries\n", PCAFILE);
+ fprintf (fpout, "OOPS: %s contains too many entries\n", PCAFILE);
+ exit (1);
+ }
+ fclose (fppca);
*kp = K;
*Vp = V;
*outlierp = outlier;
}
-void getphenos(int NSAMPLES, double **iscasep, int *outlier,
- double **iscasecorrp, int L, double *V) {
+void
+getphenos (int NSAMPLES, double **iscasep, int *outlier, double **iscasecorrp,
+ int L, double *V)
+{
- int k,n;
+ int k, n;
double *iscase, *iscasecorr;
- double rowsum, rowsum1, gamma, denom ;
+ double rowsum, rowsum1, gamma, denom;
/* allocate iscase */
- if ((iscase = (double *)malloc(NSAMPLES*sizeof(*iscase))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if ((iscasecorr = (double *)malloc(NSAMPLES*sizeof(*iscasecorr))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
+ if ((iscase = (double *) malloc (NSAMPLES * sizeof(*iscase))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
+ if ((iscasecorr = (double *) malloc (NSAMPLES * sizeof(*iscasecorr))) == NULL)
+ {
+ fprintf (stderr, "CM\n");
+ exit (1);
+ }
/* get phenotypes */
- for(n=0; n<NSAMPLES; n++)
- {
-
- if ( qtmode == NO ) {
-
- char *grp = strdup(indivmarkers[n]->egroup);
- int i;
- for(i=0;i<strlen(grp);i++)
- grp[i] = tolower(grp[i]);
-
- if ( !strcmp(grp,"case") ) {
- iscase[n] = 1.0;
- }
- else if ( !strcmp(grp,"control") ) {
- iscase[n] = 0.0;
- }
- else if ( indivmarkers[n]->ignore == YES ) {
- iscase[n] = -100.0;
- }
- else {
- fprintf(stderr,"OOPS bad phenotype %s\n",grp);
- fprintf(fpout,"OOPS bad phenotype %s\n",grp);
- exit(1);
- }
- free(grp);
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO)
+ {
+
+ char *grp = strdup (indivmarkers[n]->egroup);
+ int i;
+ for (i = 0; i < strlen (grp); i++)
+ grp[i] = tolower(grp[i]);
+
+ if (!strcmp (grp, "case"))
+ {
+ iscase[n] = 1.0;
+ }
+ else if (!strcmp (grp, "control"))
+ {
+ iscase[n] = 0.0;
+ }
+ else if (indivmarkers[n]->ignore == YES)
+ {
+ iscase[n] = -100.0;
+ }
+ else
+ {
+ fprintf (stderr, "OOPS bad phenotype %s\n", grp);
+ fprintf (fpout, "OOPS bad phenotype %s\n", grp);
+ exit (1);
+ }
+ free (grp);
+
+ }
+ else
+ {
+ iscase[n] = indivmarkers[n]->qval;
+ }
}
- else {
- iscase[n] = indivmarkers[n]->qval;
- }
- }
/* mean-adjust iscase */
- rowsum = 0.0; rowsum1 = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if((outlier[n] == 1) || (iscase[n] == -100) )
- continue;
- rowsum += iscase[n];
- rowsum1 += 1.0;
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(iscase[n] == -100.0) iscase[n] = -100.0; /* still keep track */
- else iscase[n] -= rowsum/rowsum1;
- }
+ rowsum = 0.0;
+ rowsum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if ((outlier[n] == 1) || (iscase[n] == -100))
+ continue;
+ rowsum += iscase[n];
+ rowsum1 += 1.0;
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (iscase[n] == -100.0)
+ iscase[n] = -100.0; /* still keep track */
+ else
+ iscase[n] -= rowsum / rowsum1;
+ }
/* make iscasecorr */
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n] == 0) iscasecorr[n] = iscase[n];
- }
- for(k=0; k<L; k++)
- {
- gamma = 0.0;
- denom = 0.0;
- for(n=0; n<NSAMPLES; n++)
+ for (n = 0; n < NSAMPLES; n++)
{
- if(qtmode == NO && ((outlier[n]) || (iscase[n] < -99.0))) continue;
- if(qtmode == YES && ((outlier[n]) || (iscase[n] == -100.0))) continue;
- gamma += iscasecorr[n]*V[NSAMPLES*n+k];
- denom += V[NSAMPLES*n+k]*V[NSAMPLES*n+k];
+ if (outlier[n] == 0)
+ iscasecorr[n] = iscase[n];
}
- gamma /= denom;
- for(n=0; n<NSAMPLES; n++)
+ for (k = 0; k < L; k++)
{
- if(qtmode == NO && ((outlier[n]) || (iscase[n] < -99.0))) continue;
- if(qtmode == YES && ((outlier[n]) || (iscase[n] == -100.0))) continue;
- iscasecorr[n] -= gamma*V[NSAMPLES*n+k];
+ gamma = 0.0;
+ denom = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO && ((outlier[n]) || (iscase[n] < -99.0)))
+ continue;
+ if (qtmode == YES && ((outlier[n]) || (iscase[n] == -100.0)))
+ continue;
+ gamma += iscasecorr[n] * V[NSAMPLES * n + k];
+ denom += V[NSAMPLES * n + k] * V[NSAMPLES * n + k];
+ }
+ gamma /= denom;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (qtmode == NO && ((outlier[n]) || (iscase[n] < -99.0)))
+ continue;
+ if (qtmode == YES && ((outlier[n]) || (iscase[n] == -100.0)))
+ continue;
+ iscasecorr[n] -= gamma * V[NSAMPLES * n + k];
+ }
}
- }
*iscasep = iscase;
*iscasecorrp = iscasecorr;
}
-double compute_chisq(double *source, double *target)
+double
+compute_chisq (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(qtmode == NO && source[n] < -99.0) continue;
- if(qtmode == YES && source[n] == -100.0) continue;
-
- if(qtmode == NO && target[n] < -99.0) continue;
- if(qtmode == YES && target[n] == -100.0) continue;
-
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
-
- corr = (numer/sqrt(denom1*denom2));
- return (sum1*corr*corr);
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (qtmode == NO && source[n] < -99.0)
+ continue;
+ if (qtmode == YES && source[n] == -100.0)
+ continue;
+
+ if (qtmode == NO && target[n] < -99.0)
+ continue;
+ if (qtmode == YES && target[n] == -100.0)
+ continue;
+
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
+
+ corr = (numer / sqrt (denom1 * denom2));
+ return (sum1 * corr * corr);
}
-double compute_chisqE(double *source, double *target)
+double
+compute_chisqE (double *source, double *target)
{
int n;
double sum1, sumx, sumxx, sumy, sumyy, sumxy, numer, denom1, denom2;
double corr;
- sum1 = 0.0; sumx = 0.0; sumxx = 0.0; sumy = 0.0; sumyy = 0.0; sumxy = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n]) continue;
- if(qtmode == NO && source[n] < -99.0) continue;
- if(qtmode == YES && source[n] == -100.0) continue;
-
- if(qtmode == NO && target[n] < -99.0) continue;
- if(qtmode == YES && target[n] == -100.0) continue;
-
- sumx += source[n];
- sumxx += source[n]*source[n];
- sumy += target[n];
- sumyy += target[n]*target[n];
- sumxy += source[n]*target[n];
- sum1 += 1.0;
- }
- if(sumxx == 0.0) return -1.0;
- if(sumyy == 0.0) return -1.0;
- numer = sumxy/sum1 - (sumx/sum1)*(sumy/sum1);
- denom1 = (sumxx/sum1 - (sumx/sum1)*(sumx/sum1));
- denom2 = (sumyy/sum1 - (sumy/sum1)*(sumy/sum1));
- if(denom1 <= 0.0) return -1.0;
- if(denom2 <= 0.0) return -1.0;
-
- corr = (numer/sqrt(denom1*denom2));
- sum1 = sum1 - ((double)(L+1));
- return (sum1*corr*corr);
+ sum1 = 0.0;
+ sumx = 0.0;
+ sumxx = 0.0;
+ sumy = 0.0;
+ sumyy = 0.0;
+ sumxy = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n])
+ continue;
+ if (qtmode == NO && source[n] < -99.0)
+ continue;
+ if (qtmode == YES && source[n] == -100.0)
+ continue;
+
+ if (qtmode == NO && target[n] < -99.0)
+ continue;
+ if (qtmode == YES && target[n] == -100.0)
+ continue;
+
+ sumx += source[n];
+ sumxx += source[n] * source[n];
+ sumy += target[n];
+ sumyy += target[n] * target[n];
+ sumxy += source[n] * target[n];
+ sum1 += 1.0;
+ }
+ if (sumxx == 0.0)
+ return -1.0;
+ if (sumyy == 0.0)
+ return -1.0;
+ numer = sumxy / sum1 - (sumx / sum1) * (sumy / sum1);
+ denom1 = (sumxx / sum1 - (sumx / sum1) * (sumx / sum1));
+ denom2 = (sumyy / sum1 - (sumy / sum1) * (sumy / sum1));
+ if (denom1 <= 0.0)
+ return -1.0;
+ if (denom2 <= 0.0)
+ return -1.0;
+
+ corr = (numer / sqrt (denom1 * denom2));
+ sum1 = sum1 - ((double) (L + 1));
+ return (sum1 * corr * corr);
}
diff --git a/src/eigensrc/smartpca.c b/src/eigensrc/smartpca.c
index 4de0290..4068148 100644
--- a/src/eigensrc/smartpca.c
+++ b/src/eigensrc/smartpca.c
@@ -30,94 +30,94 @@
Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
+ */
#define WVERSION "13050"
/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
+ Simple eigenvector analysis
+ Options to look at groups (simple ANOVA)
+ Weights allowed for individuals
+ missing mode
+ dotpops added
+ recompiled with new twtail. Output form at changed
+ Cleaned up twestxx
+ fancynorm mode (divide by sqrt(p*(1-p))
+ poplistname supported. Eigenanalysis just on individuals in population
+ But all individuals figure in eigenvector output
+ New way of computing effective marker size (twl2mode)
+ popdifference implemented
+ ldregression ldlimit (genetic distance in Morgans)
+ nostatslim added
+ dotpop has new format if many groups
+ uses new I/O
+ Supports packmode
+ Alkes style outlier removal added
+ Only half XTX computed
+ xdata (huge array) removed
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
+ fst calculation added
+ popsizelimit added
+ divergence added (not useful?)
-SNPs discarded if no data.
-Phylipfile now supported
+ SNPs discarded if no data.
+ Phylipfile now supported
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
+ Preparations for parallelization made
+ Various fixups for EIGENSTRAT and altnormstyle
-output capability added (like convertf)
+ output capability added (like convertf)
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
+ bug fixed (a last iteration needed for outlier removal)
+ bug fixed (numindivs unlimited)
+ output files fixed up (NULL OK)
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
+ Many Alkes style options added
+ Support for outliername added (outlier info)
+ familyname added (ped files)
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+ bugfix: jackrat dies (outlier removes all of population)
+ bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
+ nrows, ncols output added
+ nrows, ncols set each outlier iteration
+ indivs with no data removed
-writesnpeig added
+ writesnpeig added
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
+ bugfix: popsize of 1 no anova done
+ minallelecnt added
+ chrom: added
+ latest greatest handling of chromosome number added.
+ bad bugfix: numvalidgtypes
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
+ checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
+ pubmean added
-fst on X
-fst std errors now fixed
+ fst on X
+ fst std errors now fixed
-bad bug fixed (outfiles changed indivmarkers) ...
+ bad bug fixed (outfiles changed indivmarkers) ...
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
+ fstdetailsname added
+ fsthiprecision added
+ bug fixed (getrawcolx)
-bad bug fix. xtypes not allocated correctly
+ bad bug fix. xtypes not allocated correctly
-version compatible with Mac
-XTX.dbg commented out
+ version compatible with Mac
+ XTX.dbg commented out
-outliermode added
+ outliermode added
-regmode added
-maxpops parametric. Use easymode if large
+ regmode added
+ maxpops parametric. Use easymode if large
-id2pops added
+ id2pops added
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-bugfix to ldregx (Angela Yu)
-*/
+ Threading added Chris Chang)
+ fastmode (Kevin Galinski)
+ bugfix to ldregx (Angela Yu)
+ */
#if _WIN32
// just in case we try a Windows port in the future
@@ -140,222 +140,285 @@ bugfix to ldregx (Angela Yu)
#define MAXSTR 512
#define MAXPOPS 1000
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *parname = NULL;
+char *twxtabname = NULL;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-long seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int fastdim = -1 ;
-int fastiter= -1 ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
+SNP **snpmarkers;
+
+int numsnps, numindivs;
+int numeigs = 10; /// default
+int markerscore = NO;
+int maxpops = 100;
+long seed = 0;
+int chisqmode = NO; // approx p-value better to use F-stat
+int missingmode = NO;
+int shrinkmode = NO;
+int dotpopsmode = YES;
+int noxdata = YES; /* default as pop structure dubious if Males and females */
+int fstonly = NO;
+int pcorrmode = NO;
+int pcpopsonly = YES;
+int nostatslim = 10;
+int znval = -1;
+int popsizelimit = -1;
+int altnormstyle = YES; // affects subtle details in normalization formula
+int minallelecnt = 1;
+int maxmissing = 9999999;
+int lopos = -999999999, hipos = 999999999; // use with xchrom
+
+int packout = -1;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+extern int packmode;
+extern int numchrom;
+extern int fancynorm;
+extern int verbose;
+int ogmode = NO;
+int fsthiprec = NO;
+int inbreed = NO; // for fst
+int easymode = NO;
+int fastmode = NO;
+int fastdim = -1;
+int fastiter = -1;
+int regmode = NO;
+
+int numoutliter = 5, numoutleigs = 10, outliermode = 0;
+double outlthresh = 6.0;
+OUTLINFO **outinfo;
+char *outinfoname = NULL;
+char *fstdetailsname = NULL;
+
+double plo = .001;
+double phi = .999;
+double pvhit = .001;
+double pvjack = 1.0e-6;
+double *chitot;
+int *xpopsize;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *deletesnpoutname = NULL;
+char *poplistname = NULL;
+char *xregionname = NULL; /* physical positions of SNPs to exclude */
+char *outliername = NULL;
+char *phylipname = NULL;
+char *snpeigname = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *omode = "packedancestrymap";
+char *grmoutname = NULL;
+int grmbinary = NO;
+double blgsize = 0.05; // block size in Morgans */
+char *id2pops = NULL;
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+int killr2 = NO;
+int pubmean = YES; // change default
double nhwfilter = -1.0;
int thread_ct_config = 0;
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
+int randomfillin = NO;
+int usepopsformissing = NO; // if YES popmean is used for missing. Overall mean if all missing for pop
-int xchrom = -1 ;
+int xchrom = -1;
// list of outliers
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+int ldregress = 0;
+double ldlimit = 9999.0; /* default is infinity */
+double ldr2lo = 0.01;
+double ldr2hi = 0.95;
+int ldposlimit = 1000 * 1000 * 1000;
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi);
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum);
+
+char *outputname = NULL;
+char *outputvname = NULL;
+char *weightname = NULL;
+FILE *ofile, *ovfile;
+
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+twnorm (double lam, double m, double n);
+double
+rhoinv (double x, double gam);
+
+void
+readcommands (int argc, char **argv);
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+fvadjust (double *rr, int n, double *pmean, double *fancy);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+int
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1);
+int
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1);
+void
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows);
+
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+double
+anova1 (double *vec, int len, int *xtypes, int numeg);
+double
+anova (double *vec, int len, int *xtypes, int numeg);
+void
+publishit (char *sss, int df, double chi);
+
+void
+setmiss (SNP **snpm, int numsnps);
+void
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
+void
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
+void
+printxcorr (double *X, int nrows, Indiv **indxx);
+
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
+void
+addoutersym (double *X, double *v, int n);
+void
+symit (double *X, int n);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
+void
+jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
+void
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf);
+void
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int marker_ct,
+ uint32_t indiv_ct);
+void
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols);
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+void
+fixwt (SNP **snpm, int nsnp, double val);
+void
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex);
+void
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname);
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile) ;
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile);
uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
+triangle_divide (int64_t cur_prod, int32_t modif)
{
// return smallest integer vv for which (vv * (vv + modif)) is no smaller
// than cur_prod, and neither term in the product is negative. (Note the
// lack of a divide by two; cur_prod should also be double its "true" value
// as a result.)
int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
+ if (cur_prod == 0)
+ {
+ if (modif < 0)
+ {
+ return -modif;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ vv = (int64_t) sqrt ((double) cur_prod);
+ while ((vv - 1) * (vv + modif - 1) >= cur_prod)
+ {
+ vv--;
+ }
+ while (vv * (vv + modif) < cur_prod)
+ {
+ vv++;
}
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
return vv;
}
void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
+parallel_bounds (uint32_t ct, int32_t start, uint32_t parallel_idx,
+ uint32_t parallel_tot, int32_t* bound_start_ptr,
+ int32_t* bound_end_ptr)
{
int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
+ int64_t ct_tot = ((int64_t) ct) * (ct + modif);
+ *bound_start_ptr = triangle_divide ((ct_tot * parallel_idx) / parallel_tot,
+ modif);
+ *bound_end_ptr = triangle_divide (
+ (ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
}
// set align to 1 for no alignment
void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
+triangle_fill (uint32_t* target_arr, uint32_t ct, uint32_t pieces,
+ uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start,
+ uint32_t align)
{
int32_t modif = 1 - start * 2;
uint32_t cur_piece = 1;
@@ -365,31 +428,34 @@ triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t paral
int32_t ubound;
uint32_t uii;
uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
+ parallel_bounds (ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
// x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
align *= 2;
align_m1 = align - 1;
target_arr[0] = lbound;
target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
+ cur_prod = ((int64_t) lbound) * (lbound + modif);
+ ct_tr = (((int64_t) ubound) * (ubound + modif) - cur_prod) / pieces;
+ while (cur_piece < pieces)
+ {
+ cur_prod += ct_tr;
+ lbound = triangle_divide (cur_prod, modif);
+ uii = (lbound - ((int32_t) start)) & align_m1;
+ if ((uii) && (uii != align_m1))
+ {
+ lbound = start + ((lbound - ((int32_t) start)) | align_m1);
+ }
+ // lack of this check caused a nasty bug earlier
+ if (((uint32_t) lbound) > ct)
+ {
+ lbound = ct;
+ }
+ target_arr[cur_piece++] = lbound;
+ }
}
void
-symit2(double* XTX, uintptr_t nrows)
+symit2 (double* XTX, uintptr_t nrows)
{
// unpacks LOWER-triangle-only symmetric matrix representation into regular
// square matrix.
@@ -397,39 +463,48 @@ symit2(double* XTX, uintptr_t nrows)
uintptr_t col_idx;
double* read_col;
double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
+ if (nrows < 3)
+ {
+ if (nrows < 2)
+ {
+ return;
+ }
+ // special case, need to avoid overlapping memcpy
+ XTX[3] = XTX[2];
+ XTX[2] = XTX[1];
return;
}
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
+ for (row_idx = nrows - 1; row_idx; row_idx--)
+ {
+ memcpy (&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]),
+ (row_idx + 1) * sizeof(double));
+ }
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ read_col = &(XTX[row_idx]);
+ write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
+ for (col_idx = row_idx + 1; col_idx < nrows; col_idx++)
+ {
+ *write_ptr++ = read_col[col_idx * nrows];
+ }
}
- }
}
void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
+copy_transposed (double* orig_matrix, uintptr_t orig_row_ct,
+ uintptr_t orig_col_ct, double* transposed_matrix)
{
uintptr_t new_row_idx;
uintptr_t new_col_idx;
double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++)
+ {
+ orig_col_ptr = &(orig_matrix[new_row_idx]);
+ for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++)
+ {
+ *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ }
}
- }
}
// make these file scope so multithreading works
@@ -443,1990 +518,2292 @@ static double* g_weights;
static uintptr_t* g_binary_cols;
static uintptr_t* g_binary_mmask;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww, *evals ;
+ char sss[MAXSTR];
+ char **eglist;
+ int numeg;
+ int i, j, k, k1, k2, pos;
+ int *vv;
+ SNP *cupt;
+ Indiv *indx;
+ double y1 = 0, y2, y2l, y, y3;
+
+ int n0, n1, nkill;
+
+ int nindiv = 0;
+ double ychi, tail, tw;
+ int nignore, numrisks = 1;
+ double *xrow, *xpt;
+ SNP **xsnplist;
+ Indiv **xindlist;
+ int *xindex, *xtypes = NULL;
+ int nrows, ncols, m, nused;
+ double *XTX, *cc, *evecs, *ww, *evals;
double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
- int rngmode = NO ;
-
-
- int xblock ;
+ double *lambda, *esize;
+ double zn, zvar;
+ double *fvecs, *fxvecs, *fxscal;
+ double *ffvecs;
+ int weightmode = NO;
+ double ynrows;
+ int t, tt;
+ double *xmean, *xfancy;
+ double *ldvv = NULL, ynumsnps = 0; // for grm
+ int *ldsnpbuff = NULL;
+ int lastldchrom, numld;
+ double *fstans, *fstsd;
+ double *inbans, *inbsd;
+
+ int chrom;
+ int outliter, numoutiter, *badlist, nbad;
+ FILE *outlfile, *phylipfile;
+ double *eigkurt, *eigindkurt;
+ double *wmean;
+ char **elist;
+ double *shrink;
+ double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL;
+ int kk;
+ double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq;
+ int rngmode = NO;
+
+ int xblock;
int blocksize = 1024;
double *tblock = NULL;
int* binary_rawcol = NULL;
uintptr_t* binary_cols = NULL;
uintptr_t* binary_mmask = NULL;
- OUTLINFO *outpt ;
+ OUTLINFO *outpt;
pthread_t threads[MAX_THREADS];
uint32_t thread_ct;
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fastmode) {
- if (fastiter < 0) fastiter = numeigs;
- if (fastdim < 0) fastdim = 2*numeigs;
- rngmode = YES ;
- }
-
- if (popsizelimit>0) rngmode = YES ;
-
- if (rngmode) {
- if (seed==0) seed = seednum() ;
- printf("seed: %ld\n", seed) ;
- SRAND(seed) ;
- }
+ readcommands (argc, argv);
+ printf ("## smartpca version: %s\n", WVERSION);
+ packmode = YES;
+ setomode (&outputmode, omode);
+ if (parname == NULL)
+ return 0;
+ if (xchrom == (numchrom + 1))
+ noxdata = NO;
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
+ if (fastmode)
+ {
+ if (fastiter < 0)
+ fastiter = numeigs;
+ if (fastdim < 0)
+ fastdim = 2 * numeigs;
+ rngmode = YES;
+ }
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
+ if (popsizelimit > 0)
+ rngmode = YES;
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
+ if (rngmode)
+ {
+ if (seed == 0)
+ seed = seednum ();
+ printf ("seed: %ld\n", seed);
+ SRAND (seed);
+ }
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
+ if (usepopsformissing)
+ {
+ printf ("usepopsformissing => easymode\n");
+ easymode = YES;
+ }
- nostatslim = MAX(nostatslim, 3) ;
+ if (deletesnpoutname != NULL)
+ { /* remove because snplog opens in append mode */
+ char buff[256];
+ sprintf (buff, "rm -f %s", deletesnpoutname);
+ system (buff);
+ }
- outlfile = ofile = stdout;
+ if (fstonly)
+ {
+ printf ("fstonly\n");
+ numeigs = 0;
+ numoutliter = 0;
+ numoutiter = 0;
+ outputname = NULL;
+ snpeigname = NULL;
+ }
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
+ if (fancynorm)
+ printf ("norm used\n\n");
+ else
+ printf ("no norm used\n\n");
+ if (regmode)
+ printf ("lsqproject used\n");
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
+ nostatslim = MAX(nostatslim, 3);
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
+ outlfile = ofile = stdout;
- numindivs = getindivs(indivname, &indivmarkers) ;
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
+ if (outliername != NULL)
+ openit (outliername, &outlfile, "w");
+ if (fstdetailsname != NULL)
+ openit (fstdetailsname, &fstdetails, "w");
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
+ if ((ldlimit <= 0) || (ldposlimit <= 0))
+ ldregress = 0;
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+ numindivs = getindivs (indivname, &indivmarkers);
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
+ if (id2pops != NULL)
+ {
+ setid2pops (id2pops, indivmarkers, numindivs);
+ }
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
+ k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
}
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
+ else
+ {
+ setstatus (indivmarkers, numindivs, NULL);
+ ZALLOC(eglist, MAXPOPS, char *);
+ numeg = makeeglist (eglist, maxpops, indivmarkers, numindivs);
}
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
+ for (i = 0; i < numeg; i++)
+ {
+ /* printf("%3d %s\n",i, eglist[i]) ; */
}
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
+
+ nindiv = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == YES)
+ ++nindiv;
}
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ chrom = cupt->chrom;
+ if ((noxdata) && (chrom == (numchrom + 1)))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-X", deletesnpoutname);
+ }
+ if (chrom == 0)
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-0", deletesnpoutname);
+ }
+ if (chrom > (numchrom + 1))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-big", deletesnpoutname);
+ }
}
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
+ for (i = 0; i < numsnps; i++)
{
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
+ cupt = snpmarkers[i];
+ pos = nnint (cupt->physpos);
+ if ((xchrom > 0) && (cupt->chrom != xchrom))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "not-chrom", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos < lopos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "lopos", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos > hipos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "hipos", deletesnpoutname);
+ }
+ if (cupt->ignore)
+ continue;
+ if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
+ {
+ printf ("nodata: %20s\n", cupt->ID);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "nodata", deletesnpoutname);
+ }
}
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
+ if (xregionname)
+ {
+ excluderegions (xregionname, snpmarkers, numsnps, deletesnpoutname);
+ }
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
+ if (nhwfilter > 0)
+ {
+ hwfilter (snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
+ }
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
+ ZALLOC(vv, numindivs, int);
+ numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
+ for (i = 0; i < numindivs; ++i)
+ {
+ if (vv[i] == 0)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = YES;
+ }
+ }
+ free (vv);
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
+ numsnps = rmsnps (snpmarkers, numsnps, deletesnpoutname); // rid ignorable snps
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
+ if (missingmode)
+ {
+ setmiss (snpmarkers, numsnps);
+ fancynorm = NO;
+ }
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
+ if (weightname != NULL)
+ {
+ weightmode = YES;
+ getweights (weightname, snpmarkers, numsnps);
+ }
+ if (ldregress > 0)
+ {
+ ZALLOC(ldvv, ldregress*numindivs, double);
+ ZALLOC(ldsnpbuff, ldregress, int); // index of snps
+ }
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
+ ZALLOC(xindex, numindivs, int);
+ ZALLOC(xindlist, numindivs, Indiv *);
+ ZALLOC(xsnplist, numsnps, SNP *);
+ if (popsizelimit > 0)
+ {
+ setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
+ }
/* Load non-ignored individuals into xindlist,xindex:
* xindex[i] = index into indivmarkers
* xindlist[i] = pointer to Indiv struct */
- ZALLOC(xtypes, numindivs, int) ;
-
-
+ ZALLOC(xtypes, numindivs, int);
/* Load non-ignored SNPs into xsnplist:
* xsnplist[i] = pointer to SNP struct */
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
+ printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);
- if (fastmode) {
+ if (fastmode)
+ {
- setgval(xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols) ;
+ setgval (xsnplist, nrows, indivmarkers, numindivs, xindex, xtypes, ncols);
// side-effect monomorphic snps -> ignore
- ZALLOC(evals, numeigs, double) ;
- ZALLOC(evecs, numeigs*nrows, double) ;
+ ZALLOC(evals, numeigs, double);
+ ZALLOC(evecs, numeigs*nrows, double);
- kjg_fpca(numeigs, fastdim, fastiter,
- evals, evecs);
+ kjg_fpca (numeigs, fastdim, fastiter, evals, evecs);
- if (verbose) {
- printf("##bug: \n") ; printmat(evals, 1, numeigs) ; printmat(evecs, 1, 20) ;
- }
-
- transpose(evecs, evecs, nrows, numeigs) ;
+ if (verbose)
+ {
+ printf ("##bug: \n");
+ printmat (evals, 1, numeigs);
+ printmat (evecs, 1, 20);
+ }
- printevecs(xsnplist, indivmarkers, xindlist,
- numindivs, ncols, nrows, numeigs,
- evecs, evals, ofile) ;
+ transpose (evecs, evecs, nrows, numeigs);
+ printevecs (xsnplist, indivmarkers, xindlist, numindivs, ncols, nrows,
+ numeigs, evecs, evals, ofile);
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
+ printf ("end of smartpca(fastmode)\n");
+ return 0;
-}
-
+ }
/* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
+ ZALLOC(xmean, ncols, double);
+ ZALLOC(xfancy, ncols, double);
+
+ ZALLOC(XTX, nrows*nrows, double);
+ ZALLOC(evecs, nrows*nrows, double);
+ if ((!usepopsformissing) && (ldregress == 0))
+ {
+ // should not use lookup table if
+ // - usepopsformissing is set (since each population may have a different
+ // mean), or
+ // - ldregress > 0
#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
+ blocksize = 20;
+ ZALLOC(partial_sum_lookup_buf, 131072, double);
#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
+ blocksize = 10;
+ ZALLOC(partial_sum_lookup_buf, 65536, double);
#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
+ ZALLOC(binary_rawcol, nrows, int);
+ ZALLOC(binary_cols, nrows, uintptr_t);
+ ZALLOC(binary_mmask, nrows, uintptr_t);
+ ZALLOC(tblock, 3 * blocksize, double);
+ }
+ else
+ {
+ ZALLOC(tblock, nrows*blocksize, double);
+ }
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
+ ZALLOC(lambda, nrows, double);
+ ZALLOC(esize, nrows, double);
+ ZALLOC(cc, (nrows > 3)? nrows : 3, double);
+ ZALLOC(ww, nrows, double);
+ ZALLOC(badlist, nrows, int);
- blocksize = MIN(blocksize, ncols) ;
+ blocksize = MIN(blocksize, ncols);
// xfancy is multiplier for column xmean is mean to take off
// badlist is list of rows to delete (outlier removal)
- numoutiter = 1 ;
+ numoutiter = 1;
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
+ if (numoutliter >= 1)
+ {
+ numoutiter = numoutliter + 1;
+ ZALLOC(outinfo, nrows, OUTLINFO *);
+ for (k = 0; k < nrows; k++)
+ {
+ ZALLOC(outinfo[k], 1, OUTLINFO);
+ }
+ /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
+ setoutliermode (outliermode);
+ }
+ else
+ setoutliermode (2);
// try to autodetect number of (virtual) processors, and use that number to
// set the thread count. allow the user to override this in the future
#if _WIN32
SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
+ if (thread_ct_config <= 0)
+ {
+ GetSystemInfo(&sysinfo);
+ thread_ct = sysinfo.dwNumberOfProcessors;
+ }
+ else
+ {
+ thread_ct = thread_ct_config;
+ }
#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
+ if (thread_ct_config <= 0)
+ {
+ i = sysconf (_SC_NPROCESSORS_ONLN);
+ if (i == -1)
+ {
+ thread_ct = 1;
+ }
+ else
+ {
+ thread_ct = i;
+ }
}
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
+ else
+ {
+ thread_ct = thread_ct_config;
}
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
+#endif
+ if (thread_ct > 8)
+ {
+ if (thread_ct > MAX_THREADS)
+ {
+ thread_ct = MAX_THREADS;
+ }
+ else
+ {
+ thread_ct--;
+ }
}
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ if (thread_ct > nrows * 2)
+ {
+ thread_ct = nrows / 2;
+ if (!thread_ct)
+ {
+ thread_ct = 1;
+ }
}
+ printf ("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1) ? "" : "s",
+ (partial_sum_lookup_buf) ? ", and partial sum lookup algorithm" : "");
+ triangle_fill (g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
+ nkill = 0;
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
+ for (outliter = 1; outliter <= numoutiter; ++outliter)
+ {
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
+ if (fstonly)
+ {
+ setidmat (XTX, nrows);
+ vclear (lambda, 1.0, nrows);
+ break;
+ }
+ if (outliter > 1)
+ {
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ }
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
+ vzero (XTX, (nrows * (nrows + 1)) / 2);
+ xblock = 0;
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
+ vzero (xmean, ncols);
+ vclear (xfancy, 1.0, ncols);
- ++xblock ;
- ++nused ;
+ nused = 0;
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
+ }
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
+ numld = 0;
+ lastldchrom = -1;
+ ynumsnps = 0;
+ if (partial_sum_lookup_buf)
+ {
+ for (i = 0; i < nrows; i++)
+ {
+ binary_cols[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ binary_mmask[i] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ vzero (tblock, nrows * blocksize);
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ chrom = cupt->chrom;
+ if (!partial_sum_lookup_buf)
+ {
+ tt = getcolxz (cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy,
+ &n0, &n1);
+ }
+ else
+ {
+ tt = getcolxz_binary1 (binary_rawcol, cc, cupt, xindex, nrows, i,
+ xmean, xfancy, &n0, &n1);
+ }
+
+ t = MIN(n0, n1);
+
+ if ((t < minallelecnt) || (tt > maxmissing) || (tt < 0) || (t == 0))
+ {
+ t = MAX(t, 0);
+ tt = MAX(tt, 0);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "minallelecnt", deletesnpoutname);
+ vzero (cc, nrows);
+ if (nkill < 10)
+ printf (" snp %20s ignored . allelecnt: %5d missing: %5d\n",
+ cupt->ID, t, tt);
+ ++nkill;
+ continue;
+ }
+
+ if (lastldchrom != chrom)
+ numld = 0;
+
+ if (!partial_sum_lookup_buf)
+ {
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, nrows);
+ }
+
+ if (ldregress > 0)
+ {
+
+ t = ldregx (ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi);
+ if (t < 2)
+ {
+ bumpldvv (ldvv, cc, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ ynumsnps += asum2 (ww, nrows) / asum2 (cc, nrows);
+ // don't need to think hard about how cc is normalizes
+ }
+ else
+ {
+ // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
+ bumpldvv (ldvv, ww, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ }
+ copyarr (ww, cc, nrows);
+ }
+ else
+ ++ynumsnps;
+ copyarr (cc, tblock + xblock * nrows, nrows);
+ }
+ else
+ {
+ getcolxz_binary2 (binary_rawcol, binary_cols, binary_mmask,
+ xblock, nrows);
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, 3);
+ }
+ ++ynumsnps;
+ copyarr (cc, &(tblock[xblock * 3]), 3);
+ }
+
+ ++xblock;
+ ++nused;
+
+ /** this is the key code to parallelize */
+ if (xblock == blocksize)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock,
+ nrows, partial_sum_lookup_buf);
+ for (j = 0; j < nrows; j++)
+ {
+ binary_cols[j] = 0;
+ }
+ for (j = 0; j < nrows; j++)
+ {
+ binary_mmask[j] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock,
+ xblock, nrows);
+ vzero (tblock, nrows * blocksize);
+ }
+ xblock = 0;
+ }
+ }
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
+ if (xblock > 0)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock, nrows,
+ partial_sum_lookup_buf);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock, xblock,
+ nrows);
+ }
+ }
+ symit2 (XTX, nrows);
+ printf ("total number of snps killed in pass: %d used: %d\n", nkill,
+ nused);
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
+ if (verbose)
+ {
+ printdiag (XTX, nrows);
+ }
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
+ y = trace (XTX, nrows) / (double) (nrows - 1);
+ if (isnan(y))
+ fatalx ("bad XTX matrix\n");
+ /* printf("trace: %9.3f\n", y) ; */
+ if (y <= 0.0)
+ fatalx ("XTX has zero trace (perhaps no data)\n");
+ vst (XTX, XTX, 1.0 / y, nrows * nrows);
- eigvecs(XTX, lambda, evecs, nrows) ;
+ eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
+ if (outliter > numoutliter)
+ break;
+ // last pass skips outliers
+ numoutleigs = MIN(numoutleigs, nrows - 1);
+ nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
+ outinfo);
+ if (nbad == 0)
+ break;
+ for (i = 0; i < nbad; i++)
+ {
+ j = badlist[i];
+ indx = xindlist[j];
+ outpt = outinfo[j];
+ fprintf (outlfile,
+ "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
+ indx->ID, outliter, outpt->vecno, outpt->score,
+ indx->egroup);
+ indx->ignore = YES;
+ }
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ printf ("number of samples after outlier removal: %d\n", nrows);
+ }
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
+ if (outliername != NULL)
+ fclose (outlfile);
+ dumpgrm (XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname);
+ if (grmoutname != NULL)
+ printf ("grm dumped\n");
- m = numgtz(lambda, nrows) ;
+ m = numgtz (lambda, nrows);
/* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
+ if (m == 0)
+ fatalx ("no data\n");
/* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
+ if (settwxtable (twxtabname) < 0)
+ {
+ printf ("\n## To get Tracy-Widom statistics: recompile smartpca with");
+ printf (" TWTAB correctly specified in Makefile, or\n");
+ printf (" just run twstats (see README file in POPGEN directory)\n");
+ }
else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
+ {
+ /* *** START of code to print Tracy-Widom statistics */
+ printf ("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows,
+ ncols);
+ y = -1.0;
+ printf ("%4s %12s", "#N", "eigenvalue");
+ printf ("%12s", "difference");
+ printf (" %9s %12s", "twstat", "p-value");
+ printf (" %9s", "effect. n");
+ printf ("\n");
+
+ ynrows = (double) nrows;
+
+ for (i = 0; i < m; ++i)
+ {
+ if (fstonly)
+ break;
+ zn = znval;
+ if (zn > 0)
+ zn = MAX(ynrows, zn);
+ tail = dotwcalc (lambda + i, m - i, &tw, &zn, &zvar, nostatslim);
+ esize[i] = zn;
+ printf ("%4d %12.6f", i + 1, lambda[i]);
+ if (i == 0)
+ printf ("%12s", "NA");
+ else
+ printf ("%12.6f", lambda[i] - lambda[i - 1]);
+ if (tail >= 0.0)
+ printf (" %9.3f %12.6g", tw, tail);
+ else
+ printf (" %9s %12s", "NA", "NA");
+ if (zn > 0.0)
+ {
+ printf (" %9.3f", zn);
+ }
+ else
+ {
+ printf (" %9s", "NA");
+ }
+ printf ("\n");
+ }
+ /* END of code to print Tracy-Widom statistics */
}
- /* END of code to print Tracy-Widom statistics */
- }
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
+ numeigs = MIN(numeigs, nrows);
+ numeigs = MIN(numeigs, ncols);
+
+ ZALLOC(shrink, numeigs, double);
+ vclear (shrink, 1.0, numeigs);
+ t = nrows - numeigs;
+ if (t > 0)
+ y1 = asum (lambda + numeigs, t) / (double) t;
+ y = (double) nrows / esize[numeigs];
+ y = MIN(y, 1.0 / y); // gamma
+ for (j = 0; j < numeigs; j++)
+ {
+ if (!shrinkmode)
+ break;
+ if (t <= 0)
+ break;
+ if (esize[j] < 0.1)
+ break;
+ y2 = lambda[j] / y1;
// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
+ y2l = rhoinv (y2, y);
+ if (y2l < 0.0)
+ break;
+ y3 = (y2l - 1.0) / (y2l + y - 1.0);
+ y3 = MIN(y3, 1.0);
+ if (y3 < 0.0)
+ y3 = 1.0;
+ shrink[j] = y3;
+ printf ("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l);
+ }
/* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
/* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
/* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
/* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", lambda[j]);
}
- fclose(ovfile) ;
- }
+ fprintf (ofile, "\n");
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
-
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
}
- }
- }
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
-
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
+ fclose (ovfile);
}
- }
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
-
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(fxvecs, nrows*numeigs, double);
+ ZALLOC(fxscal, numeigs, double);
- for (i=0; i<nrows; i++) {
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(xrow, ncols, double);
+ setfvecs (fvecs, evecs, nrows, numeigs);
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
+ if (easymode)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ if (pubmean)
+ {
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(elist, numeg, char *);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ calcpopmean (wmean, elist, xpt, eglist, numeg, xtypes, nrows);
+ printf ("eig: %d ", j + 1);
+ printf ("min: %s %9.3f ", elist[0], wmean[0]);
+ printf ("max: %s %9.3f ", elist[numeg - 1], wmean[numeg - 1]);
+ printnl ();
+ for (k = 0; k < numeg; ++k)
+ {
+ printf ("%20s ", elist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
+ }
+ }
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
+ printf ("## easymode set. end of smartpca run\n");
+ return 0;
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * cc[k];
+ }
+ }
+ }
- for (j=0; j<numeigs; j++) {
+ ZALLOC(eigkurt, numeigs, double);
+ ZALLOC(eigindkurt, numeigs, double);
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ eigkurt[j] = kurtosis (ffvecs + j * ncols, ncols);
+ eigindkurt[j] = kurtosis (fvecs + j * nrows, nrows);
+ }
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
+ for (i = 0; i < nrows; i++)
+ {
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
+ loadxdataind (xrow, xsnplist, xindex[i], ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
+ for (j = 0; j < numeigs; j++)
+ {
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
+ xpt = ffvecs + j * ncols;
+ y = fxvecs[j * nrows + i] = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
+ }
+ }
+
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j];
+// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
+ fxscal[j] = 1.0 / sqrt (y); // standard
+ }
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
-
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
-
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
-
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
+ ZALLOC(acoeffs, numindivs*numeigs, double);
+ ZALLOC(bcoeffs, numindivs*numeigs, double);
+ if (partial_sum_lookup_buf)
+ {
+ free (partial_sum_lookup_buf);
+ free (binary_rawcol);
+ free (binary_cols);
+ free (binary_mmask);
+ }
+ free (tblock);
+ if (regmode)
+ {
+ ZALLOC(trow, ncols, double);
+ ZALLOC(rhs, ncols, double);
+ ZALLOC(emat, ncols*numeigs, double);
+ ZALLOC(regans, numeigs, double);
+ /**
+ for (j=0; j<numeigs; ++j) {
+ xpt = ffvecs+j*ncols ;
+ y = asum2(xpt, ncols) ;
+ fxscal[j] = (double) ncols / sqrt(y*y) ;
}
+ */
+ }
+ for (i = 0; i < numindivs; i++)
+ {
+ if (!regmode)
+ break;
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ copyarr (xrow, trow, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ kk = 0;
+ for (k = 0; k < ncols; ++k)
+ {
+ if (trow[k] < 0)
+ continue;
+ rhs[kk] = xrow[k];
+ for (j = 0; j < numeigs; j++)
+ {
+ emat[kk * numeigs + j] = fxscal[j] * ffvecs[j * ncols + k];
+ }
+ ++kk;
+ }
+ if (kk <= numeigs)
+ {
+ indx->ignore = YES;
+ printf ("%s ignored (insufficient data\n", indx->ID);
+ continue;
+ }
+ regressit (regans, emat, rhs, kk, numeigs);
+ for (j = 0; j < numeigs; ++j)
+ {
+ acoeffs[j * numindivs + i] = regans[j];
+ }
+ }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j] * vdot (xrow, ffvecs + j * ncols, ncols);
+ if (shrinkmode && (indx->affstatus == YES))
+ y *= shrink[j];
+ bcoeffs[j * numindivs + i] = y;
+ }
+ }
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
+ if (!regmode)
+ {
+ free (acoeffs);
+ acoeffs = bcoeffs;
+ }
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
+ ZALLOC(azq, nrows*numeigs, double);
+ ZALLOC(bzq, nrows*numeigs, double);
+
+ sqz (azq, acoeffs, numeigs, nrows, xindex);
+ sqz (bzq, bcoeffs, numeigs, nrows, xindex);
+ for (j = 0; j < numeigs; ++j)
+ {
+ if (!regmode)
+ break;
+ apt = azq + j * nrows;
+ bpt = bzq + j * nrows;
+ y = vdot (apt, bpt, nrows) / vdot (apt, apt, nrows);
+ vst (acoeffs + j * numindivs, acoeffs + j * numindivs, y, numindivs);
+ }
+
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = acoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ if (qtmode)
+ {
+ fprintf (ofile, "%15.6e\n", indx->qval);
+ }
+ else
+ {
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ }
+
+ printf ("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs");
+
+ for (j = 0; j < numeigs; ++j)
+ {
+ y1 = eigkurt[j];
+ y2 = eigindkurt[j];
+ printf ("%12s %4d %9.3f %9.3f\n", "eigenvector", j + 1, y1, y2);
+ }
// output files
- settersemode(YES) ;
+ settersemode (YES);
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
+ ZALLOC(xpopsize, numeg, int);
+ for (i = 0; i < numeg; i++)
+ {
+ xpopsize[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ ++xpopsize[k];
+ }
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
+ for (i = 0; i < numeg; i++)
+ {
+ printf ("population: %3d %20s %4d", i, eglist[i], xpopsize[i]);
+ if (xpopsize[i] == 0)
+ printf (" ***");
+ printnl ();
+ }
+ if (numeg == 1)
+ dotpopsmode = NO;
- if (numeg==1) dotpopsmode = NO ;
+ if (dotpopsmode == NO)
+ {
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ printxcorr (XTX, nrows, xindlist);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
+ ZALLOC(chitot, numeg*numeg, double);
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
+ dotpops (XTX, eglist, numeg, xtypes, nrows);
+ ZALLOC(fstans, numeg*numeg, double);
+ ZALLOC(fstsd , numeg*numeg, double);
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
+ setinbreed (inbreed);
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ if (inbreed)
+ {
+ ZALLOC(inbans, numeg, double);
+ ZALLOC(inbsd , numeg, double);
+ doinbxx (inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+ printf ("## inbreeding coeffs: inbreed std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %20s %10.4f %10.4f\n", eglist[k1], inbans[k1], inbsd[k1]);
}
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ free (inbans);
+ free (inbsd);
+ }
+
+ dofstxx (fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+
+ if ((phylipname == NULL) && (numeg > 10))
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ if (fsthiprec == NO)
+ {
+ printf (" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ if (fsthiprec == YES)
+ {
+ printf (" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ }
}
- }
+ printf ("\n");
}
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
+ if (fstdetailsname != NULL)
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ fprintf (fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1],
+ eglist[k2], fstans[k1 * numeg + k2],
+ fstsd[k1 * numeg + k2]);
+ }
+ }
+ fprintf (fstdetails, "\n");
}
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
+
+ if (phylipname != NULL)
+ {
+ openit (phylipname, &phylipfile, "w");
+ fprintf (phylipfile, "%6d\n", numeg);
+ sss[10] = CNULL;
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ strncpy (sss, eglist[k1], 10);
+ fprintf (phylipfile, "%10s", sss);
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ y1 = fstans[k1 * numeg + k2];
+ y2 = fstans[k2 * numeg + k1];
+ fprintf (phylipfile, "%6.3f", (0.5 * (y1 + y2)));
+ }
+ fprintf (phylipfile, "\n");
+ }
+ fclose (phylipfile);
}
- fclose(phylipfile) ;
- }
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
+ if ((numeg <= 10) || fstonly)
+ {
+ if (fsthiprec == NO)
+ {
+ printf ("fst *1000:");
+ printnl ();
+ printmatz5 (fstans, eglist, numeg);
+ printnl ();
+ }
+ if (fsthiprec == YES)
+ {
+ printf ("fst *1000000:");
+ printnl ();
+ printmatz10 (fstans, eglist, numeg);
+ printnl ();
+ }
}
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
+ printf ("s.dev * 1000000:\n");
+ vst (fstsd, fstsd, 1000.0, numeg * numeg);
+ printmatz5 (fstsd, eglist, numeg);
+ printnl ();
+ fflush (stdout);
+ if (fstonly)
+ {
+ printf ("##end of smartpca run\n");
+ return 0;
}
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
+ vst (fstsd, fstsd, 1.0 / 1000.0, numeg * numeg);
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "eigenvector %d", j + 1);
+ y = dottest (sss, evecs + j * nrows, eglist, numeg, xtypes, nrows);
+ }
- printxcorr(XTX, nrows, xindlist) ;
+ printf ("\n## Statistical significance of differences beween populations:\n");
+ printf (
+ " pop1 pop2 chisq p-value |pop1| |pop2|\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ if (fstonly)
+ break;
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ ychi = chitot[k1 * numeg + k2];
+ tail = rtlchsq (numeigs, ychi);
+ printf ("popdifference: %20s %20s %12.3f %12.6g", eglist[k1],
+ eglist[k2], ychi, tail);
+ printf (" %5d", xpopsize[k1]);
+ printf (" %5d", xpopsize[k2]);
+ printf ("\n");
+ }
+ }
+ printf ("\n");
+ for (i = 0; i < ncols; i++)
+ {
+ if (markerscore == NO)
+ break;
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+ sprintf (sss, "%s raw", cupt->ID);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "%s subtract sing vec %d", cupt->ID, j + 1);
+ y = vdot (cc, evecs + j * nrows, nrows);
+ vst (ww, evecs + j * nrows, y, nrows);
+ vvm (cc, cc, ww, nrows);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ }
+ }
+ printxcorr (XTX, nrows, xindlist);
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- printf("##end of smartpca run\n") ;
- return 0 ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- phandle *ph ;
- int t ;
+ int i;
+ phandle *ph;
+ int t;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
+
+ if (parname == NULL)
+ {
+ fprintf (stderr, "no parameters\n");
+ return;
+ }
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
- getint(ph, "seed:", &t) ; seed = (long) t ;
-
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "fastdim:", &fastdim) ;
- getint(ph, "fastiter:", &fastiter) ;
-
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "snpeigname:", &snpeigname);
+ getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "outputvecs:", &outputname);
+ getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
+ getstring (ph, "outputvals:", &outputvname);
+ getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "outliername:", &outliername);
+ getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
+ getstring (ph, "phylipname:", &phylipname);
+ getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
+ getstring (ph, "weightname:", &weightname);
+ getstring (ph, "fstdetailsname:", &fstdetailsname);
+ getstring (ph, "deletsnpoutname:", &deletesnpoutname);
+ getint (ph, "numeigs:", &numeigs);
+ getint (ph, "maxpops:", &maxpops);
+ maxpops = MIN(maxpops, MAXPOPS);
+ getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
+ getint (ph, "markerscore:", &markerscore);
+ getint (ph, "chisqmode:", &chisqmode);
+ getint (ph, "missingmode:", &missingmode);
+ getint (ph, "shrinkmode:", &shrinkmode);
+ getint (ph, "fancynorm:", &fancynorm);
+ getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
+ getint (ph, "dotpopsmode:", &dotpopsmode);
+ getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
+ getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
+ getint (ph, "altnormstyle:", &altnormstyle);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "popgenmode:", &altnormstyle);
+ getint (ph, "noxdata:", &noxdata);
+ getint (ph, "inbreed:", &inbreed);
+ getint (ph, "easymode:", &easymode);
+ getint (ph, "seed:", &t);
+ seed = (long) t;
+
+ getint (ph, "fastmode:", &fastmode);
+ getint (ph, "fastdim:", &fastdim);
+ getint (ph, "fastiter:", &fastiter);
+
+ getint (ph, "usepopsformissing:", &usepopsformissing);
+ getint (ph, "regmode:", ®mode);
+ getint (ph, "lsqproject:", ®mode);
+
+ t = -1;
+ getint (ph, "xdata:", &t);
+ if (t >= 0)
+ noxdata = 1 - t;
+ getint (ph, "nostatslim:", &nostatslim);
+ getint (ph, "popsizelimit:", &popsizelimit);
+ getint (ph, "minallelecnt:", &minallelecnt);
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "maxmissing:", &maxmissing);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "pubmean:", &pubmean);
+ getint (ph, "fstonly:", &fstonly);
+ getint (ph, "fsthiprecision:", &fsthiprec);
+
+ getint (ph, "ldregress:", &ldregress);
+ getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
+ getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
+ getint (ph, "ldposlimit:", &ldposlimit); /* bases */
+ getdbl (ph, "ldr2lo:", &ldr2lo);
+ getdbl (ph, "ldr2hi:", &ldr2hi);
+ getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
+ getint (ph, "minleneig:", &nostatslim);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "familynames:", &familynames);
+ getint (ph, "qtmode:", &qtmode);
+
+ getint (ph, "numoutliter:", &numoutliter);
+ getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
+ getint (ph, "numoutleigs", &numoutleigs);
+ getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
+ getdbl (ph, "outlthresh:", &outlthresh);
+ getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
+ getint (ph, "outliermode:", &outliermode); /* test distribution with sample removed. Makes sense for small samples */
+ getdbl (ph, "blgsize:", &blgsize);
+
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getint (ph, "outputgroup:", &ogmode);
+ getstring (ph, "grmoutname:", &grmoutname);
+ getint (ph, "grmbinary:", &grmbinary);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getstring (ph, "twxtabname:", &twxtabname);
+ getstring (ph, "id2pops:", &id2pops);
+
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+ getint (ph, "killr2:", &killr2);
+
+ getint (ph, "numchrom:", &numchrom);
+ getstring (ph, "xregionname:", &xregionname);
+ getdbl (ph, "hwfilter:", &nhwfilter);
+
+ getint (ph, "numthreads:", &thread_ct_config);
+
+ printf ("### THE INPUT PARAMETERS\n");
+ printf ("##PARAMETER NAME: VALUE\n");
+ writepars (ph);
}
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
+int
+fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean force missing to zero */
/* set up fancy norming */
{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
+ double p, ynum, ysum, y, ymean, yfancy = 1.0;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ {
+ return -999;
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ if (fancynorm)
+ {
+ p = 0.5 * ymean; // autosomes
+ if (altnormstyle == NO)
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ yfancy = 1.0 / sqrt (y);
+ }
+ if (fancy != NULL)
+ *fancy = yfancy;
+ return nmiss;
}
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
+int
+fvadjust_binary (int c0, int c1, int nmiss, int n, double* cc, double* pmean,
+ double* fancy)
{
double p, ynum, ysum, y, ymean, yfancy = 1.0;
- if (n == nmiss) {
- return -999;
- }
+ if (n == nmiss)
+ {
+ return -999;
+ }
ynum = n - nmiss;
ysum = c0;
ymean = ysum / ynum;
cc[0] = -ymean;
cc[1] = 1.0 - ymean;
cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
+ if (fancynorm)
+ {
+ p = 0.5 * ymean;
+ if (altnormstyle == NO)
+ {
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ }
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ {
+ yfancy = 1.0 / sqrt (y);
+ }
}
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
+ if (pmean)
+ {
+ *pmean = ymean;
+ }
+ if (fancy)
+ {
+ *fancy = yfancy;
}
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
return nmiss;
}
double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0
// perhaps should rewrite to put xa1 etc in arrays
{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
- }
- }
-
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
- }
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
- }
- ++ncall ;
-
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
- }
-
-
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
+ double *w1;
+ int *xt;
+ int i, k1, k2, k, n, x1, x2;
+ double ylike;
+ double ychi;
+ double *wmean;
+ int imax, imin, *isort;
+ static int ncall = 0;
+
+ char ss1[MAXSTR];
+ char ss2[MAXSTR];
+ double ans, ftail, ftailx, ansx;
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(w1, len + numeg, double);
+ ZALLOC(isort, numeg, int);
+ ZALLOC(xt, len, int);
+ strcpy (ss1, "");
+
+ calcmean (wmean, vec, len, xtypes, numeg);
+ if (pubmean)
+ {
+ copyarr (wmean, w1, numeg);
+ sortit (w1, isort, numeg);
+ printf ("%s:means\n", sss);
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ printf ("%20s ", eglist[k]);
+ printf (" %9.3f\n", wmean[k]);
}
- }
+ }
+
+ vlmaxmin (wmean, numeg, &imax, &imin);
+ if (chisqmode)
+ {
+ ylike = anova1 (vec, len, xtypes, numeg);
+ ans = 2.0 * ylike;
+ }
+ else
+ {
+ ans = ftail = anova (vec, len, xtypes, numeg);
+ }
+ ++ncall;
+
+ if (numeg > 2)
+ {
+ sprintf (ss2, "%s %s ", sss, "overall");
+ publishit (ss2, numeg - 1, ans);
+ printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
+ eglist[imax], wmean[imax]);
+ }
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ n = 0;
+ x1 = x2 = 0;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ if (k == k1)
+ {
+ w1[n] = vec[i];
+ xt[n] = 0;
+ ++n;
+ ++x1;
+ }
+ if (k == k2)
+ {
+ w1[n] = vec[i];
+ xt[n] = 1;
+ ++n;
+ ++x2;
+ }
+ }
+
+ if (x1 <= 1)
+ continue;
+ if (x2 <= 1)
+ continue;
+
+ ylike = anova1 (w1, n, xt, 2);
+ ychi = 2.0 * ylike;
+ chitot[k1 * numeg + k2] += ychi;
+ if (chisqmode)
+ {
+ ansx = ychi;
+ }
+ else
+ {
+ ansx = ftailx = anova (w1, n, xt, 2);
+ }
+
+ sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
+ publishit (ss2, 1, ansx);
+
+ }
+ }
+ free (w1);
+ free (xt);
+ free (wmean);
+ free (isort);
+ return ans;
}
-double anova(double *vec, int len, int *xtypes, int numeg)
+double
+anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, top, bot, ftail;
+ double *w0, *w1, *popsize, *wmean;
- static int ncall2 = 0 ;
+ static int ncall2 = 0;
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
+ if (numeg >= len)
+ {
+ printf ("*** warning: bad anova popsizes too small\n");
+ return 0.0;
+ }
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
+ /* debug */
+ if (numeg == 2)
+ {
+ ++ncall2;
+ for (i = 0; i < len; ++i)
+ {
+ if (ncall2 < 0)
+ break;
+ k = xtypes[i];
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
+ }
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ vvt (w1, wmean, wmean, numeg);
+ top = vdot (w1, popsize, numeg);
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
+ bot = asum2 (w1, len) / (double) (len - numeg);
+ bot *= (double) (numeg - 1);
+ ftail = rtlf (numeg - 1, len - numeg, top / bot);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ftail ;
+ return ftail;
}
-double anova1(double *vec, int len, int *xtypes, int numeg)
+double
+anova1 (double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, y2, ylike;
+ double *w0, *w1, *popsize, *wmean;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
+ y1 = asum2 (w0, len) / (double) len;
+ y2 = asum2 (w1, len) / (double) len;
+ ylike = 0.5 * ((double) len) * log (y1 / y2);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ylike ;
+ return ylike;
}
-void publishit(char *sss, int df, double chi)
+void
+publishit (char *sss, int df, double chi)
{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
+ double tail;
+ char sshit[4];
+ char ss2[MAXSTR];
+ int i, n;
+ char cblank, cunder;
+ static int ncall = 0;
+
+ ++ncall;
+ cblank = ' ';
+ cunder = '_';
+ n = strlen (sss);
+
+ strcpy (ss2, sss);
+ for (i = 0; i < n; ++i)
+ {
+ if (ss2[i] == cblank)
+ ss2[i] = cunder;
+ }
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
+ if (chisqmode)
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
+ printf ("%40s %6d %9.3f", ss2, df, chi);
+ tail = rtlchsq (df, chi);
+ printf (" %12.6g", tail);
+ }
+ else
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %12s\n", "", "p-value");
+ printf ("%40s ", ss2);
+ tail = chi;
+ printf (" %12.6g", tail);
+ }
+ strcpy (sshit, "");
+ if (tail < pvhit)
+ strcpy (sshit, "***");
+ if (tail < pvjack)
+ strcpy (sshit, "+++");
+ printf (" %s", sshit);
+ printf ("\n");
}
void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
+ double *pp, *npp, val, yy;
+ int *popsize;
+ int i, j, k1, k2;
+
+ if (fstonly)
+ return;
+ ZALLOC(pp, numeg * numeg, double);
+ ZALLOC(npp, numeg * numeg, double);
+ popsize = xpopsize;
+
+ ivzero (popsize, numeg);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k1 = xtypes[i];
+ ++popsize[k1];
+ for (j = i + 1; j < nrows; j++)
+ {
+ k2 = xtypes[j];
+ if (k1 < 0)
+ fatalx ("bug\n");
+ if (k2 < 0)
+ fatalx ("bug\n");
+ if (k1 >= numeg)
+ fatalx ("bug\n");
+ if (k2 >= numeg)
+ fatalx ("bug\n");
+ val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
+ pp[k1 * numeg + k2] += val;
+ pp[k2 * numeg + k1] += val;
+ ++npp[k1 * numeg + k2];
+ ++npp[k2 * numeg + k1];
+ }
+ }
+ vsp (npp, npp, 1.0e-8, numeg * numeg);
+ vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
+ yy = trace (pp, numeg) / (double) numeg;
+ vst (pp, pp, 1.0 / yy, numeg * numeg);
+ printf ("\n## Average divergence between populations:");
+ if (numeg <= 10)
+ {
+ printf ("\n");
+ printf ("%10s", "");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %10s", eglist[k1]);
+ }
+ printf (" %10s", "popsize");
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ printf ("%10s", eglist[k2]);
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ };
+ printf (" %10d", popsize[k2]);
+ printf ("\n");
+ }
+ }
+ else
+ { // numeg >= 10
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ for (k1 = k2; k1 < numeg; ++k1)
+ {
+ printf ("dotp: %10s", eglist[k2]);
+ printf (" %10s", eglist[k1]);
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ printf (" %10d", popsize[k2]);
+ printf (" %10d", popsize[k1]);
+ printf ("\n");
+ }
+ }
+ }
+ printf ("\n");
+ printf ("\n");
+ fflush (stdout);
- free(pp) ;
- free(npp) ;
+ free (pp);
+ free (npp);
}
-void printxcorr(double *X, int nrows, Indiv **indxx)
+void
+printxcorr (double *X, int nrows, Indiv **indxx)
{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
+ int k1, k2, t;
+ double y1, y2, yy, rho;
+ Indiv *ind1, *ind2;
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
+ if (pcorrmode == NO)
+ return;
+ for (k1 = 0; k1 < nrows; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < nrows; ++k2)
+ {
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
+ ind1 = indxx[k1];
+ ind2 = indxx[k2];
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
+ t = strcmp (ind1->egroup, ind2->egroup);
+ if (pcpopsonly && (t != 0))
+ continue;
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
+ y1 = X[k1 * nrows + k1];
+ y2 = X[k2 * nrows + k2];
+ yy = X[k1 * nrows + k2];
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
+ rho = yy / sqrt (y1 * y2 + 1.0e-20);
+ printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
+ ind1->egroup, ind2->egroup, rho);
+ }
}
- }
}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum)
{
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
+ int numld;
+ SNP *cuptnew, *cuptold;
+ int pdiff;
+ double gdiff;
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
-
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
-
- *pnumld = numld ;
- return ;
+ numld = *pnumld;
+
+ cuptnew = snpmarkers[newsnpnum];
+
+ for (;;)
+ {
+ if (numld == 0)
+ break;
+ cuptold = snpmarkers[ldsnpbuff[0]];
+ pdiff = nnint (cuptnew->physpos - cuptold->physpos);
+ gdiff = cuptnew->genpos - cuptold->genpos;
+ if ((pdiff <= ldposlimit) && (gdiff <= ldlimit))
+ break;
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+
+ if (numld < maxld)
+ {
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+ *pnumld = numld;
+ return;
+ }
+
+ if (maxld == numld)
+ {
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+
+ *pnumld = numld;
+ return;
}
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi)
{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
+ /**
+ gsource: array of (normalized) genotypes
+ rsize rows n long.
+ So row 1 is gsource[0]..gsource[n-1]
+ row 2 gsource[n]...gsource[2*n-1]
+ gtarget n long normalized genotype
+ Routine should return residual (n long)
+
+ return code
+ a) 0 Did nothing
+ b) 1 Ran regression
+ c) 2 Residual set 0
+ */
+
+ if (rsize == 0)
+ {
+ copyarr (gtarget, res, n);
+ return 0;
+ }
// Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
+ double *gsource_pass;
+ ZALLOC(gsource_pass, rsize * n, double);
- int i,ii;
+ int i, ii;
// Compute correlation to previous SNPs
double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
+ int rsize_pass = 0;
+ for (i = 0; i < rsize; i++)
+ {
+ sum = 0;
+ for (ii = 0; ii < n; ii++)
+ {
+ sum += gtarget[ii] * gsource[i * n + ii];
+ }
+ // Normalize by (n-1) and square to get cor^2
+ sum = pow (sum / (2 * (n - 1)), 2);
+ // Check if correlation too high
+ if (sum > r2hi)
+ {
+ // Clean up and exit
+ free (gsource_pass);
+
+ // Residual set to all zero
+ for (ii = 0; ii < n; ii++)
+ res[ii] = 0;
+ return 2;
+ // Check if correlation not too low
+ }
+ else if (sum > r2lo)
+ {
+ // Retain this SNP for the regression
+ for (ii = 0; ii < n; ii++)
+ gsource_pass[rsize_pass * n + ii] = gsource[i * n + ii];
+ rsize_pass++;
+ }
}
- }
// Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
+ if (rsize_pass > 0)
+ {
+ double *t_gsource_pass, *regans, *www;
+ ZALLOC(regans, rsize, double);
+ ZALLOC(www, n, double);
+ ZALLOC(t_gsource_pass, rsize * n, double);
+ // BUG FIX old call in EIG5 was wrong:
+ transpose (t_gsource_pass, gsource_pass, rsize_pass, n);
- // BUG FIX old call in EIG5 was wrong:
- transpose(t_gsource_pass,gsource_pass,rsize_pass,n);
+ regressit (regans, t_gsource_pass, gtarget, n, rsize_pass); //run regression
+ mulmat (www, regans, gsource_pass, 1, rsize_pass, n); //multiply regans and gsource_pass
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ; //run regression
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ; //multiply regans and gsource_pass
+ vvm (res, gtarget, www, n);
- vvm(res, gtarget, www, n) ;
+ free (regans);
+ free (www);
+ free (t_gsource_pass);
+ free (gsource_pass);
+ return 1;
+ }
+ else
+ {
+ copyarr (gtarget, res, n);
+ free (gsource_pass);
+ return 0;
+ }
+}
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
+
+{
+
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xfst;
+
+ if (qtmode == YES)
+ {
+ return;
+ }
+
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ printf ("number of blocks for moving block jackknife: %d\n", nblocks);
+ if (nblocks <= 1)
+ {
+ return;
+ }
+
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xfst, numeg*numeg, double);
+
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
+
+ dofstnumx (xfst, fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm, YES);
+
+ free (blstart);
+ free (blsize);
+ free (xfst);
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
}
+void
+fixwt (SNP **snpm, int nsnp, double val)
+{
+ int k;
+ SNP *cupt;
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ cupt->weight = val;
+ }
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+}
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ static int ncall = 0;
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
+ ++ncall;
+ ZALLOC(rawcol, nrows, int);
- if ( qtmode == YES ) {
- return;
- }
+ getrawcol (rawcol, cupt, xindex, nrows);
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
+ ivzero (c1, 2);
+ ivzero (c2, 2);
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
+ if (ncall < 0)
+ {
+ printf ("qq2\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ return 0.0;
+ }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
+ ed = en;
+ ed += h1;
+ ed += h2;
-}
-void fixwt(SNP **snpm, int nsnp, double val)
-{
- int k ;
- SNP *cupt ;
+ *estn = en;
+ *estd = ed;
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
+ free (rawcol);
+ return z + zz;
}
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ int **ccc;
+ static int ncall = 0;
- free(rawcol) ;
- return z + zz ;
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ZALLOC(rawcol, nrows, int);
-}
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ ivzero (c1, 2);
+ ivzero (c2, 2);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
-{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = ccc[i][0];
+ if (ncall < 1000)
+ {
// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
+ }
+
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, ccc[i], 2);
}
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
-
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
-
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- *estn = en ;
- *estd = ed ;
-
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ if (ncall < 0)
+ {
+ printf ("qqq\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 1.1) || (zz < 1.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
+
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
+
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
+
+ ed = en;
+ ed += h1;
+ ed += h2;
+
+ *estn = en;
+ *estd = ed;
+
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols)
{
// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
+ double *xpt, y, yscal, *snpsc;
+ int i, j, k, kmax, kmin;
+ SNP * cupt;
+ FILE *fff;
+ for (j = 0; j < numeigs; ++j)
+ {
+ xpt = ffvecs + j * ncols;
+ y = asum2 (xpt, ncols);
+ yscal = (double) ncols / y;
+ yscal = sqrt (yscal);
+ vst (xpt, xpt, yscal, ncols);
+ }
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
- if (ncols<=10) break ;
+ ZALLOC(snpsc, ncols, double);
+ vclear (snpsc, -99999, ncols);
+ for (j = 0; j < numeigs; ++j)
+ {
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
+ y = ffvecs[j * ncols + i];
+ snpsc[i] = fabs (y);
+ }
+ for (k = 0; k < 10; ++k)
+ {
+ if (ncols <= 10)
+ break;
// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
+ vlmaxmin (snpsc, ncols, &kmax, &kmin);
+ cupt = xsnplist[kmax];
+ if (snpsc[kmax] < 0)
+ break;
+ printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
+ cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
+ snpsc[kmax] = -1.0;
+ }
+ }
+ free (snpsc);
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
+ if (snpeigname == NULL)
+ return;
+ openit (snpeigname, &fff, "w");
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
+ fprintf (fff, "%20s", cupt->ID);
+ fprintf (fff, " %2d", cupt->chrom);
+ fprintf (fff, " %12d", nnint (cupt->physpos));
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
+ }
+ fprintf (fff, "\n");
+ }
- fclose(fff) ;
+ fclose (fff);
}
@@ -2451,96 +2828,110 @@ writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int
* g[i] set to zero where missing data
* */
-
int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
// returns missings after fill in
{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
+ int j, n, g, t, k, kmax = -1;
+ double y, pmean, yfancy;
+ int *rawcol;
+ int c0, c1, nmiss;
+ double* popnum = NULL;
+ double* popsum = NULL;
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
+ if (usepopsformissing)
+ {
+ ZALLOC(popnum, MAXPOPS+1, double);
+ ZALLOC(popsum, MAXPOPS+1, double);
+ }
+
+ c0 = c1 = 0;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ if (usepopsformissing)
+ {
+ k = xtypes[j];
+ popsum[k] += (double) g;
+ popnum[k] += 1.0;
+ kmax = MAX(kmax, k);
+ }
+ }
+ floatit (xcol, rawcol, nrows);
+ if ((usepopsformissing) && (nmiss > 0))
+ {
+ pmean = asum (popsum, kmax + 1) / asum (popnum, kmax + 1);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g >= 0)
+ continue;
+ k = xtypes[j];
+ if (popnum[k] > 0.5)
+ {
+ y = popsum[k] / popnum[k];
+ xcol[j] = y;
+ continue;
+ }
+ ++nmiss;
+ }
+ }
+ t = fvadjust (xcol, nrows, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, nrows);
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ if (usepopsformissing)
+ {
+ free (popnum);
+ free (popsum);
+ }
+ return nmiss;
}
int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1)
{
// Modified getcolxz() which converts to a 3-bit-per-genotype representation
// compatible with PLINK 1.5's partial sum lookup outer product algorithm.
@@ -2582,49 +2973,57 @@ getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
c0 = c1 = 0;
n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
+ if (n < nrows)
+ {
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ }
+ getrawcol (rawcol, cupt, xindex, nrows);
nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ }
// instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
+ t = fvadjust_binary (c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, 3);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, 3);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ return nmiss;
}
void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows)
{
// slightly better to position at 0-3-6-9-12-16-19... instead of
// 0-3-6-9-12-15-18...
@@ -2633,34 +3032,41 @@ getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
uintptr_t bitfield_or[3];
uint32_t row_idx;
int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
+ bitfield_or[0] = ((uintptr_t) 7) << shift_val;
+ bitfield_or[1] = ((uintptr_t) 2) << shift_val;
+ bitfield_or[2] = ((uintptr_t) 3) << shift_val;
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ cur_geno = *rawcol++;
+ if (cur_geno)
+ {
+ if (cur_geno > 0)
+ {
+ binary_cols[row_idx] |= bitfield_or[(uint32_t) cur_geno];
+ }
+ else
+ {
+ binary_mmask[row_idx] |= bitfield_or[0];
+ }
+ }
}
- }
}
void
-join_threads(pthread_t* threads, uint32_t ctp1)
+join_threads (pthread_t* threads, uint32_t ctp1)
{
- if (!(--ctp1)) {
- return;
- }
+ if (!(--ctp1))
+ {
+ return;
+ }
#if _WIN32
WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
#else
uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
+ for (uii = 0; uii < ctp1; uii++)
+ {
+ pthread_join (threads[uii], NULL);
+ }
#endif
}
@@ -2669,82 +3075,100 @@ int32_t
spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
#else
int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
+spawn_threads (pthread_t* threads, void*
+(*start_routine) (void*),
+ uintptr_t ct)
#endif
{
uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
+ if (ct == 1)
+ {
+ return 0;
}
+ for (ulii = 1; ulii < ct; ulii++)
+ {
+#if _WIN32
+ threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
+ if (!threads[ulii - 1])
+ {
+ join_threads(threads, ulii);
+ return -1;
+ }
#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
+ if (pthread_create (&(threads[ulii - 1]), NULL, start_routine,
+ (void*) ulii))
+ {
+ join_threads (threads, ulii);
+ return -1;
+ }
#endif
- }
+ }
return 0;
}
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
+THREAD_RET_TYPE block_increment_binary(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t cur_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t* binary_cols = g_binary_cols;
+ uintptr_t* binary_mmask = g_binary_mmask;
+ double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
+ double* weights0 = g_weights;
+ double* weights1 = &(g_weights[32768]);
#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
+ double* weights2 = &(g_weights[65536]);
+ double* weights3 = &(g_weights[98304]);
#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
+ uintptr_t* geno_ptr;
+ uintptr_t* mmask_ptr;
+ uintptr_t base_geno;
+ uintptr_t base_mmask;
+ uintptr_t final_geno;
+ uintptr_t indiv_idx2;
+ for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ geno_ptr = binary_cols;
+ base_geno = binary_cols[cur_indiv_idx];
+ mmask_ptr = binary_mmask;
+ base_mmask = binary_mmask[cur_indiv_idx];
+ if (!base_mmask)
+ {
+ // special case: current individual has no missing genotypes in block
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
+ write_ptr++;
+ }
+ }
+ else
+ {
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf)
{
// PLINK 1.5 partial sum lookup algorithm
double increments[40];
@@ -2768,80 +3192,93 @@ domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lowe
#else
for (uii = 0; uii < 10; uii += 5)
#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
+ {
+ dptr = increments;
+ for (ujj = 0; ujj < 5; ujj++)
+ {
+ dptr2 = &(tblock[(uii + ujj) * 3]);
+ *dptr++ = dptr2[0] * dptr2[0];
+ *dptr++ = 0;
+ *dptr++ = dptr2[0] * dptr2[1];
+ *dptr++ = dptr2[0] * dptr2[2];
+ *dptr++ = dptr2[1] * dptr2[1];
+ *dptr++ = dptr2[1] * dptr2[2];
+ *dptr++ = dptr2[2] * dptr2[2];
+ *dptr++ = 0;
+ }
+ dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
+ for (ujj = 0; ujj < 8; ujj++)
+ {
+ partial_incr1 = increments[ujj + 32];
+ for (ukk = 0; ukk < 8; ukk++)
+ {
+ partial_incr2 = partial_incr1 + increments[ukk + 24];
+ for (umm = 0; umm < 8; umm++)
+ {
+ partial_incr3 = partial_incr2 + increments[umm + 16];
+ for (unn = 0; unn < 8; unn++)
+ {
+ partial_incr4 = partial_incr3 + increments[unn + 8];
+ for (uoo = 0; uoo < 8; uoo++)
+ {
+ *dptr++ = partial_incr4 + increments[uoo];
+ }
+ }
+ }
+ }
+ }
}
- }
g_XTX_lower_tri = XTX_lower_tri;
g_weights = partial_sum_lookup_buf;
g_binary_cols = binary_cols;
g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_binary, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_binary ((void*) ulii);
+ join_threads (threads, thread_ct);
}
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
+THREAD_RET_TYPE block_increment_normal(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t start_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t indiv_ct = g_indiv_ct;
+ uint32_t block_size = g_block_size;
+ double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
+ double* write_ptr;
+ double* tblock;
+ double* tblock_read_ptr;
+ double cur_tblock_val;
+ uintptr_t cur_indiv_idx;
+ uintptr_t indiv_idx2;
+ uint32_t bidx;
+ for (bidx = 0; bidx < block_size; bidx++)
+ {
+ write_ptr = write_start_ptr;
+ tblock = &(g_tblock[bidx * indiv_ct]);
+ for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ cur_tblock_val = tblock[cur_indiv_idx];
+ tblock_read_ptr = tblock;
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int block_size,
+ uint32_t indiv_ct)
{
// General case: tblock[] can have an arbitrary number of distinct values, so
// can't use bit hacks.
@@ -2853,364 +3290,405 @@ domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lowe
int ii;
double ycheck;
uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
+ for (ii = 0; ii < block_size; ii++)
+ {
+ ycheck = asum (tblock + ii * indiv_ct, indiv_ct);
+ if (fabs (ycheck) > .00001)
+ fatalx ("bad ycheck\n");
+ }
g_XTX_lower_tri = XTX_lower_tri;
g_tblock = tblock;
g_block_size = block_size;
g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_normal, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_normal ((void*) ulii);
+ join_threads (threads, thread_ct);
}
void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
+ int n;
+ double pmean, yfancy;
+ int *rawcol;
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
+ if (xmean != NULL)
+ {
+ xmean[col] = xfancy[col] = 0.0;
+ }
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
+ if (cupt->ignore)
+ {
+ vzero (xcol, nrows);
+ return;
+ }
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
}
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xinb;
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xinb, numeg, double);
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ doinbreed (xinb, inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm);
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
+ free (blstart);
+ free (blsize);
+ free (xinb);
}
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len)
// extracted from dotttest ;
{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
+ double *w0, *w1;
+ int *isort;
+ int i, k;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(isort, len, int);
-
- calcmean(w0, vec, len, xtypes, numeg) ;
+ calcmean (w0, vec, len, xtypes, numeg);
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
+ copyarr (w0, w1, numeg);
+ sortit (w1, isort, numeg);
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ elist[i] = eglist[k];
+ wmean[i] = w0[k];
}
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
+ free (w0);
+ free (w1);
+ free (isort);
}
void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
{
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
+ int i, j, k;
+ // Indiv *indx ;
+ static int ncall = 0;
- ++ncall ;
+ ++ncall;
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
+ for (k = 0; k < nrows; ++k)
+ {
+ i = xindex[k];
+ if (i < 0)
+ fatalx ("zzyuk!\n");
+ // indx = indivmarkers[i] ;
// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ azq[j * nrows + k] = acoeffs[j * numindivs + i];
+ }
+ }
}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
+void
+dumpgrmid (char *fname, Indiv **indivmarkers, int *xindex, int numid)
{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
+ FILE *fff;
+ int a, b;
+ Indiv *indx;
+
+ openit (fname, &fff, "w");
+ for (a = 0; a < numid; ++a)
+ {
+ b = xindex[a];
+ if ((b < 0) || (b >= numindivs))
+ fatalx ("(dumpgrmid) bad index\n");
+ indx = indivmarkers[b];
+ fprintf (fff, "%s\t%s\n", "NA", indx->ID);
+ }
+ fclose (fff);
}
void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrmbin (double *XTX, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ double y;
+ char sss[256];
+ char *bb;
+ int wout, numout, fdes, ret = 0;
+ float yfloat;
+
+ if (sizeof(yfloat) != 4)
+ fatalx ("grm binary only supported for 4 byte floats\n");
+
+ sprintf (sss, "%s.N.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
+ numout = nrows * (nrows + 1) / 2;
+ wout = numsnps;
+ bb = (char *) &wout;
+
+ for (a = 0; a < numout; ++a)
+ {
+ ret = write (fdes, bb, 4);
+ }
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ close (fdes);
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ sprintf (sss, "%s.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
+ double y_norm;
+ y_norm = trace (XTX, nrows) / (double) nrows;
+
+ bb = (char *) &yfloat;
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b] / y_norm; // bugfix
+ yfloat = (float) y;
+ ret = write (fdes, bb, 4);
+ }
+ }
+ close (fdes);
}
void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
+ double y;
+ FILE *fff;
+ char sss[256];
+
+ if (grmoutname == NULL)
+ return;
+
+ sprintf (sss, "%s.id", grmoutname);
+ dumpgrmid (sss, indivmarkers, xindex, nrows);
+
+ if (grmbinary)
+ {
+ dumpgrmbin (XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname);
+ return;
+ }
// Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
+ double y_norm_recip;
+ double *d;
+ ZALLOC(d, nrows, double);
+ getdiag (d, XTX, nrows);
+ y_norm_recip = ((double) nrows) / asum (d, nrows);
+ free (d);
+
+ openit (grmoutname, &fff, "w");
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b]; // bugfix: do NOT want to dereference xindex here
+ fprintf (fff, "%d %d ", a + 1, b + 1);
+ fprintf (fff, "%d ", numsnps);
+ fprintf (fff, "%0.6f\n", y * y_norm_recip);
+ }
+ }
+ fclose (fff);
}
-void printevecs(SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
- int numindivs, int ncols, int nrows,
- int numeigs, double *eigenvecs, double *eigenvals, FILE *ofile)
+void
+printevecs (SNP **snpmarkers, Indiv **indivmarkers, Indiv **xindlist,
+ int numindivs, int ncols, int nrows, int numeigs, double *eigenvecs,
+ double *eigenvals, FILE *ofile)
{
- double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y ;
- double *fxscal, *xpt, val ;
- int i, j, k ;
- Indiv *indx ;
+ double *ffvecs, *fvecs, *cc, *xrow, *bcoeffs, y;
+ double *fxscal, *xpt, val;
+ int i, j, k;
+ Indiv *indx;
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", eigenvals[j]);
+ }
+ fprintf (ofile, "\n");
- if ((easymode) || (nrows == numindivs)) {
+ if ((easymode) || (nrows == numindivs))
+ {
// should be separate routine
- ZALLOC(fvecs, nrows*numeigs, double) ;
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- free(fvecs) ;
- return ;
- }
-
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(xrow, ncols, double) ;
- ZALLOC(bcoeffs, numeigs*numindivs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
-
-
-
- setfvecs(fvecs, eigenvecs, nrows, numeigs) ;
-
- for (i=0; i<ncols; i++) {
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- getgval(k, i, &val) ;
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*val ;
- }
- }
- }
-
- for (i=0; i<nrows; i++) {
-
- for (k=0; k<ncols; ++k) {
- getgval(i, k, &val) ;
- xrow[k] = val ;
- }
-
- for (j=0; j<numeigs; j++) {
- xpt = ffvecs+j*ncols ;
- y = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
- }
- }
+ ZALLOC(fvecs, nrows*numeigs, double);
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ free (fvecs);
+ return;
+ }
- vsqrt(fxscal, fxscal, numeigs) ;
- vinvert(fxscal, fxscal, numeigs) ;
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(cc, nrows, double);
+ ZALLOC(xrow, ncols, double);
+ ZALLOC(bcoeffs, numeigs*numindivs, double);
+ ZALLOC(fxscal, numeigs, double);
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- for (k=0; k<ncols; ++k) {
- getggval(i, k, &val) ;
- xrow[k] = val ;
- }
+ setfvecs (fvecs, eigenvecs, nrows, numeigs);
- for (j=0; j<numeigs; j++) {
- bcoeffs[j*numindivs+i] = y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- }
- }
-
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = bcoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
+ for (i = 0; i < ncols; i++)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ getgval (k, i, &val);
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * val;
+ }
+ }
+ }
+
+ for (i = 0; i < nrows; i++)
+ {
+
+ for (k = 0; k < ncols; ++k)
+ {
+ getgval (i, k, &val);
+ xrow[k] = val;
+ }
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = ffvecs + j * ncols;
+ y = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
+ }
+ }
+
+ vsqrt (fxscal, fxscal, numeigs);
+ vinvert (fxscal, fxscal, numeigs);
+
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ for (k = 0; k < ncols; ++k)
+ {
+ getggval (i, k, &val);
+ xrow[k] = val;
+ }
+
+ for (j = 0; j < numeigs; j++)
+ {
+ bcoeffs[j * numindivs + i] = y = fxscal[j]
+ * vdot (xrow, ffvecs + j * ncols, ncols);
+ }
+ }
- writesnpeigs(snpeigname, snpmarkers, ffvecs, numeigs, ncols) ;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = bcoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ writesnpeigs (snpeigname, snpmarkers, ffvecs, numeigs, ncols);
- free(fvecs) ;
- free(ffvecs) ;
- free(cc) ;
- free(xrow) ;
- free(bcoeffs) ;
- free(fxscal) ;
+ free (fvecs);
+ free (ffvecs);
+ free (cc);
+ free (xrow);
+ free (bcoeffs);
+ free (fxscal);
}
diff --git a/src/eigensrc/smartrel.c b/src/eigensrc/smartrel.c
index 6fea3ea..134e14b 100644
--- a/src/eigensrc/smartrel.c
+++ b/src/eigensrc/smartrel.c
@@ -21,1466 +21,1647 @@
#define WVERSION "200"
/**
-Simple eigenvector analysis
-missing mode
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
+ Simple eigenvector analysis
+ missing mode
+ fancynorm mode (divide by sqrt(p*(1-p))
+ poplistname supported. Eigenanalysis just on individuals in population
+ But all individuals figure in eigenvector output
+ New way of computing effective marker size (twl2mode)
+ popdifference implemented
+ ldregression ldlimit (genetic distance in Morgans)
+ nostatslim added
+ dotpop has new format if many groups
+ uses new I/O
+ Supports packmode
+ Alkes style outlier removal added
+ Only half XTX computed
+ xdata (huge array) removed
+
+ fst calculation added
+ popsizelimit added
+ divergence added (not useful?)
+
+ SNPs discarded if no data.
+ Phylipfile now supported
+
+ Preparations for parallelization made
+ Various fixups for EIGENSTRAT and altnormstyle
+
+ output capability added (like convertf)
+
+ bug fixed (a last iteration needed for outlier removal)
+ bug fixed (numindivs unlimited)
+ output files fixed up (NULL OK)
+
+ Many Alkes style options added
+ Support for outliername added (outlier info)
+ familyname added (ped files)
+
+ bugfix: jackrat dies (outlier removes all of population)
+ bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+
+ nrows, ncols output added
+ nrows, ncols set each outlier iteration
+ indivs with no data removed
+
+ writesnpeig added
+
+ bugfix: popsize of 1 no anova done
+ minallelecnt added
+ chrom: added
+ latest greatest handling of chromosome number added.
+ bad bugfix: numvalidgtypes
+
+ checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
+ pubmean added
+
+ */
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
-
-SNPs discarded if no data.
-Phylipfile now supported
+#define MAXFL 50
+#define MAXSTR 512
+#define MAXPOPS 100
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
+char *parname = NULL;
+char *twxtabname = NULL;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
+Indiv **indivmarkers;
+SNP **snpmarkers;
+
+int numsnps, numindivs;
+int numeigs = 10; /// default
+int markerscore = NO;
+int seed = 0;
+int chisqmode = NO; // approx p-value better to use F-stat
+int missingmode = NO;
+int dotpopsmode = YES;
+int noxdata = YES; /* default as pop structure dubious if Males and females */
+int fstonly = NO;
+int pcorrmode = NO;
+int pcpopsonly = YES;
+int nostatslim = 10;
+int znval = -1;
+int popsizelimit = -1;
+int altnormstyle = YES; // affects subtle details in normalization formula
+int minallelecnt = 1;
+int lopos = -999999999, hipos = 999999999; // use with xchrom
+
+int packout = -1;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+extern int packmode;
+extern int plotmode;
+extern int verbose;
+extern int fancynorm;
+extern int numchrom;
+
+int ogmode = NO;
+int fsthiprec = NO;
+double relthresh = 0.05;
+
+int numoutliter = 5, numoutleigs = 10;
+double outlthresh = 6.0;
+OUTLINFO **outinfo;
+char *outinfoname = NULL;
+char *fstdetailsname = NULL;
+
+double plo = .001;
+double phi = .999;
+double pvhit = .001;
+double pvjack = 1.0e-6;
+double *chitot;
+int *xpopsize;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *poplistname = NULL;
+char *outliername = NULL;
+char *phylipname = NULL;
+char *snpeigname = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *omode = "packedancestrymap";
+double blgsize = 0.05; // block size in Morgans */
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+int killr2 = NO;
+int pubmean = NO;
+
+int xchrom = -1;
+// list of outliers
-output capability added (like convertf)
+int ldregress = 0;
+double ldlimit = 9999.0; /* default is infinity */
+/* we only consider markers as in possible LD if gdis <= ldlimit */
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
+char *outputname = NULL;
+char *outputvname = NULL;
+char *weightname = NULL;
+FILE *ofile, *ovfile;
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+twnorm (double lam, double m, double n);
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+void
+readcommands (int argc, char **argv);
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+fvadjust (double *rr, int n, double *pmean, double *fancy);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+void
+getcolxz (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1);
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+double
+anova1 (double *vec, int len, int *xtypes, int numeg);
+double
+anova (double *vec, int len, int *xtypes, int numeg);
+void
+publishit (char *sss, int df, double chi);
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
+void
+setmiss (SNP **snpm, int numsnps);
+void
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
+void
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
+void
+printxcorr (double *X, int nrows, Indiv **indxx);
-writesnpeig added
+void
+ldreg (double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv,
+ double *ldvv2, int rsize, int n);
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
+void
+clearld (double *ldmat, double *ldvv, int rsize, int n, int nclear);
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
-*/
+void
+setoutliermode (int mode);
+void
+addoutersym (double *X, double *v, int n);
+void
+symit (double *X, int n);
-#define MAXFL 50
-#define MAXSTR 512
-#define MAXPOPS 100
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
-Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int plotmode ;
-extern int verbose ;
-extern int fancynorm ;
-extern int numchrom ;
-
-int ogmode = NO ;
-int fsthiprec = NO ;
-double relthresh = 0.05 ;
-
-int numoutliter = 5, numoutleigs = 10 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *poplistname = NULL ;
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-double blgsize = 0.05 ; // block size in Morgans */
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = NO ;
-
-int xchrom = -1 ;
-// list of outliers
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-/* we only consider markers as in possible LD if gdis <= ldlimit */
+void
+jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
+void
+domult (double *tvecs, double *tblock, int numrow, int len);
+void
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols);
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+void
+fixwt (SNP **snpm, int nsnp, double val);
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-void getcolxz(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void ldreg(double *ldmat, double *ldmat2,
- double *vv, double *vv2, double *ldvv,
- double *ldvv2, int rsize, int n) ;
-
-void clearld(double *ldmat, double *ldvv, int rsize, int n, int nclear) ;
-
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
-
-void setoutliermode(int mode) ;
-
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
-
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
-
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult(double *tvecs, double *tblock, int numrow, int len) ;
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
- char **eglist ;
- int numeg ;
- int i, j, k, pos;
- int *vv ;
- SNP *cupt, *cupt2 ;
- Indiv *indx ;
- double y1, y2, y ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- int nignore, numrisks = 1 ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex ;
- int nrows, ncols, m ;
- double *XTX, *cc, *evecs, *ww ;
- double *lambda ;
- double *tvecs ;
- int weightmode = NO ;
- int t ;
- double *xmean, *xfancy ;
+ char **eglist;
+ int numeg;
+ int i, j, k, pos;
+ int *vv;
+ SNP *cupt, *cupt2;
+ Indiv *indx;
+ double y1, y2, y;
+
+ int n0, n1, nkill;
+
+ int nindiv = 0;
+ int nignore, numrisks = 1;
+ SNP **xsnplist;
+ Indiv **xindlist;
+ int *xindex;
+ int nrows, ncols, m;
+ double *XTX, *cc, *evecs, *ww;
+ double *lambda;
+ double *tvecs;
+ int weightmode = NO;
+ int t;
+ double *xmean, *xfancy;
double *ldmat = NULL, *ldmat2 = NULL;
- double *ldvv = NULL, *ldvv2 = NULL, *vv2 = NULL ;
- int chrom, numclear ;
- double gdis ;
- int outliter, numoutiter, *badlist, nbad ;
- int a, b, n ;
- FILE *outlfile ;
-
-
- int xblock, blocksize=10000 ;
- double *tblock ;
-
- OUTLINFO *outpt ;
- int *idperm, *vecind ; // for sort
-
- readcommands(argc, argv) ;
- printf("## smartrel version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
-
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
-
- nostatslim = MAX(nostatslim, 3) ;
-
- outlfile = ofile = stdout;
-
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
-
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
-
- numindivs = getindivs(indivname, &indivmarkers) ;
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
-
-
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
+ double *ldvv = NULL, *ldvv2 = NULL, *vv2 = NULL;
+ int chrom, numclear;
+ double gdis;
+ int outliter, numoutiter, *badlist, nbad;
+ int a, b, n;
+ FILE *outlfile;
+
+ int xblock, blocksize = 10000;
+ double *tblock;
+
+ OUTLINFO *outpt;
+ int *idperm, *vecind; // for sort
+
+ readcommands (argc, argv);
+ printf ("## smartrel version: %s\n", WVERSION);
+ packmode = YES;
+ setomode (&outputmode, omode);
+
+ if (parname == NULL)
+ return 0;
+ if (xchrom == (numchrom + 1))
+ noxdata = NO;
+
+ if (fstonly)
+ {
+ printf ("fstonly\n");
+ numeigs = 0;
+ numoutliter = 0;
+ numoutiter = 0;
+ outputname = NULL;
+ snpeigname = NULL;
+ }
+
+ if (fancynorm)
+ printf ("norm used\n\n");
+ else
+ printf ("no norm used\n\n");
+
+ nostatslim = MAX(nostatslim, 3);
+
+ outlfile = ofile = stdout;
+
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
+ if (outliername != NULL)
+ openit (outliername, &outlfile, "w");
+ if (fstdetailsname != NULL)
+ openit (fstdetailsname, &fstdetails, "w");
+
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+
+ numindivs = getindivs (indivname, &indivmarkers);
+ k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
+
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
+ }
else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, MAXPOPS, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
-
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
-
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) cupt-> ignore = YES ;
- if (chrom == 0) cupt -> ignore = YES ;
- if (chrom > (numchrom+1)) cupt -> ignore = YES ;
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) cupt -> ignore = YES ;
- if ((xchrom > 0) && (pos < lopos)) cupt -> ignore = YES ;
- if ((xchrom > 0) && (pos > hipos)) cupt -> ignore = YES ;
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
- {
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
+ {
+ setstatus (indivmarkers, numindivs, NULL);
+ ZALLOC(eglist, MAXPOPS, char *);
+ numeg = makeeglist (eglist, MAXPOPS, indivmarkers, numindivs);
}
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
-
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
-
- numsnps = rmsnps(snpmarkers, numsnps, NULL) ; // rid ignorable snps
-
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
-
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldvv2, ldregress*numindivs, double) ;
- ZALLOC(vv2, numindivs, double) ;
- ZALLOC(ldmat, ldregress*ldregress, double) ;
- ZALLOC(ldmat2, ldregress*ldregress, double) ;
- setidmat(ldmat, ldregress) ;
- vst(ldmat, ldmat, 1.0e-6, ldregress*ldregress) ;
- }
-
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
-
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
-
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
-
-/**
- cupt = xsnplist[0] ;
- for (j=0; j<nrows; ++j) {
+ for (i = 0; i < numeg; i++)
+ {
+ /* printf("%3d %s\n",i, eglist[i]) ; */
+ }
+
+ nindiv = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == YES)
+ ++nindiv;
+ }
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ chrom = cupt->chrom;
+ if ((noxdata) && (chrom == (numchrom + 1)))
+ cupt->ignore = YES;
+ if (chrom == 0)
+ cupt->ignore = YES;
+ if (chrom > (numchrom + 1))
+ cupt->ignore = YES;
+ }
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ pos = nnint (cupt->physpos);
+ if ((xchrom > 0) && (cupt->chrom != xchrom))
+ cupt->ignore = YES;
+ if ((xchrom > 0) && (pos < lopos))
+ cupt->ignore = YES;
+ if ((xchrom > 0) && (pos > hipos))
+ cupt->ignore = YES;
+ if (cupt->ignore)
+ continue;
+ if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
+ {
+ printf ("nodata: %20s\n", cupt->ID);
+ cupt->ignore = YES;
+ }
+ }
+
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
+
+ ZALLOC(vv, numindivs, int);
+ numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
+ for (i = 0; i < numindivs; ++i)
+ {
+ if (vv[i] == 0)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = YES;
+ }
+ }
+ free (vv);
+
+ numsnps = rmsnps (snpmarkers, numsnps, NULL); // rid ignorable snps
+
+ if (missingmode)
+ {
+ setmiss (snpmarkers, numsnps);
+ fancynorm = NO;
+ }
+
+ if (weightname != NULL)
+ {
+ weightmode = YES;
+ getweights (weightname, snpmarkers, numsnps);
+ }
+ if (ldregress > 0)
+ {
+ ZALLOC(ldvv, ldregress*numindivs, double);
+ ZALLOC(ldvv2, ldregress*numindivs, double);
+ ZALLOC(vv2, numindivs, double);
+ ZALLOC(ldmat, ldregress*ldregress, double);
+ ZALLOC(ldmat2, ldregress*ldregress, double);
+ setidmat (ldmat, ldregress);
+ vst (ldmat, ldmat, 1.0e-6, ldregress * ldregress);
+ }
+
+ ZALLOC(xindex, numindivs, int);
+ ZALLOC(xindlist, numindivs, Indiv *);
+ ZALLOC(xsnplist, numsnps, SNP *);
+
+ if (popsizelimit > 0)
+ {
+ setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
+ }
+
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);
+
+ /**
+ cupt = xsnplist[0] ;
+ for (j=0; j<nrows; ++j) {
k = xindex[j] ;
g = getgtypes(cupt, k) ;
indx = indivmarkers[k] ;
t = indxindex(eglist, numeg, indx -> egroup) ;
printf("yy1 %20s %20s %20s %d %d %d\n", cupt ->ID, indx -> ID, indx -> egroup, j, k, g) ;
- }
- printf("yya: ") ; printimat(xindex, 1, nrows) ;
- printf("zzindxa: %s\n", indivmarkers[230] -> egroup) ;
-*/
+ }
+ printf("yya: ") ; printimat(xindex, 1, nrows) ;
+ printf("zzindxa: %s\n", indivmarkers[230] -> egroup) ;
+ */
/* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- ZALLOC(tvecs, nrows*nrows, double) ;
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(cc, nrows, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
-
- blocksize = MIN(blocksize, ncols) ;
- ZALLOC(tblock, nrows*blocksize, double) ;
+ ZALLOC(xmean, ncols, double);
+ ZALLOC(xfancy, ncols, double);
+ ZALLOC(XTX, nrows*nrows, double);
+ ZALLOC(evecs, nrows*nrows, double);
+ ZALLOC(tvecs, nrows*nrows, double);
+ ZALLOC(lambda, nrows, double);
+ ZALLOC(cc, nrows, double);
+ ZALLOC(ww, nrows, double);
+ ZALLOC(badlist, nrows, int);
+
+ blocksize = MIN(blocksize, ncols);
+ ZALLOC(tblock, nrows*blocksize, double);
// xfancy is multiplier for column xmean is mean to take off
// badlist is list of rows to delete (outlier removal)
- numoutiter = 1 ;
+ numoutiter = 1;
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- }
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
- }
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
- }
- vzero(XTX, nrows*nrows) ;
- vzero(tblock, nrows*blocksize) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
-
- for (i=0; i<ncols; i++)
- {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- getcolxz(cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1) ;
- t = MIN(n0, n1) ;
-
- if (t <= minallelecnt) {
- cupt -> ignore = YES ;
- vzero(cc, nrows) ;
- }
-
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
- if (ldregress>0)
- {
- numclear = 0 ;
- for (k=1; k<= ldregress; ++k)
- {
- j = i-k ;
- if (j<0)
- {
- numclear = ldregress-k+1 ;
- break ;
- }
- cupt2 = xsnplist[j] ;
- if (cupt2 -> chrom != chrom) gdis = ldlimit + 1.0 ;
- else gdis = cupt -> genpos - cupt2 -> genpos ;
- if (gdis>=ldlimit)
- {
- numclear = ldregress-k+1 ;
- break ;
- }
+ if (numoutliter >= 1)
+ {
+ numoutiter = numoutliter + 1;
+ ZALLOC(outinfo, nrows, OUTLINFO *);
+ for (k = 0; k < nrows; k++)
+ {
+ ZALLOC(outinfo[k], 1, OUTLINFO);
}
- if (numclear>0) clearld(ldmat, ldvv, ldregress, nrows, numclear) ;
- ldreg(ldmat, ldmat2, cc, vv2, ldvv, ldvv2, ldregress, nrows) ;
- copyarr(ldmat2, ldmat, ldregress*ldregress) ;
- copyarr(vv2, cc, nrows) ;
- copyarr(ldvv2, ldvv, ldregress*nrows) ;
- }
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- ++xblock ;
-
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- domult(tvecs, tblock, xblock, nrows) ;
- vvp(XTX, XTX, tvecs, nrows*nrows) ;
- xblock = 0 ;
- vzero(tblock, nrows*blocksize) ;
- }
- }
-
- if (xblock>0)
- {
- domult(tvecs, tblock, xblock, nrows) ;
- vvp(XTX, XTX, tvecs, nrows*nrows) ;
+ /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
}
- symit(XTX, nrows) ;
-
- /**
- a = 0; b=0 ;
- printf("zz1 %12.6f ", XTX[a*nrows+b]) ;
- a = nrows-1; b=nrows-1 ;
- printf(" %12.6f %15.9g\n", XTX[a*nrows+b], asum(XTX, nrows*nrows)) ;
- */
- if (verbose)
+ for (outliter = 1; outliter <= numoutiter; ++outliter)
{
- printdiag(XTX, nrows) ;
- }
+ if (fstonly)
+ {
+ setidmat (XTX, nrows);
+ vclear (lambda, 1.0, nrows);
+ break;
+ }
+ if (outliter > 1)
+ {
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ }
+ vzero (XTX, nrows * nrows);
+ vzero (tblock, nrows * blocksize);
+ xblock = 0;
+
+ vzero (xmean, ncols);
+ vclear (xfancy, 1.0, ncols);
+
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ chrom = cupt->chrom;
+ getcolxz (cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
+ t = MIN(n0, n1);
+
+ if (t <= minallelecnt)
+ {
+ cupt->ignore = YES;
+ vzero (cc, nrows);
+ }
+
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, nrows);
+ }
+ if (ldregress > 0)
+ {
+ numclear = 0;
+ for (k = 1; k <= ldregress; ++k)
+ {
+ j = i - k;
+ if (j < 0)
+ {
+ numclear = ldregress - k + 1;
+ break;
+ }
+ cupt2 = xsnplist[j];
+ if (cupt2->chrom != chrom)
+ gdis = ldlimit + 1.0;
+ else
+ gdis = cupt->genpos - cupt2->genpos;
+ if (gdis >= ldlimit)
+ {
+ numclear = ldregress - k + 1;
+ break;
+ }
+ }
+ if (numclear > 0)
+ clearld (ldmat, ldvv, ldregress, nrows, numclear);
+ ldreg (ldmat, ldmat2, cc, vv2, ldvv, ldvv2, ldregress, nrows);
+ copyarr (ldmat2, ldmat, ldregress * ldregress);
+ copyarr (vv2, cc, nrows);
+ copyarr (ldvv2, ldvv, ldregress * nrows);
+ }
+ copyarr (cc, tblock + xblock * nrows, nrows);
+ ++xblock;
+
+ /** this is the key code to parallelize */
+ if (xblock == blocksize)
+ {
+ domult (tvecs, tblock, xblock, nrows);
+ vvp (XTX, XTX, tvecs, nrows * nrows);
+ xblock = 0;
+ vzero (tblock, nrows * blocksize);
+ }
+ }
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
+ if (xblock > 0)
+ {
+ domult (tvecs, tblock, xblock, nrows);
+ vvp (XTX, XTX, tvecs, nrows * nrows);
+ }
+ symit (XTX, nrows);
+
+ /**
+ a = 0; b=0 ;
+ printf("zz1 %12.6f ", XTX[a*nrows+b]) ;
+ a = nrows-1; b=nrows-1 ;
+ printf(" %12.6f %15.9g\n", XTX[a*nrows+b], asum(XTX, nrows*nrows)) ;
+ */
+
+ if (verbose)
+ {
+ printdiag (XTX, nrows);
+ }
+
+ y = trace (XTX, nrows) / (double) (nrows - 1);
+ if (isnan(y))
+ fatalx ("bad XTX matrix\n");
+ /* printf("trace: %9.3f\n", y) ; */
+ if (y <= 0.0)
+ fatalx ("XTX has zero trace (perhaps no data)\n");
+ vst (XTX, XTX, 1.0 / y, nrows * nrows);
/// mean eigenvalue is 1
- eigvecs(XTX, lambda, evecs, nrows) ;
+ eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f\n", indx -> ID, outliter, outpt -> vecno, outpt -> score) ;
- indx -> ignore = YES ;
+ if (outliter > numoutliter)
+ break;
+ // last pass skips outliers
+ numoutleigs = MIN(numoutleigs, nrows - 1);
+ nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
+ outinfo);
+ if (nbad == 0)
+ break;
+ for (i = 0; i < nbad; i++)
+ {
+ j = badlist[i];
+ indx = xindlist[j];
+ outpt = outinfo[j];
+ fprintf (outlfile,
+ "REMOVED outlier %s iter %d evec %d sigmage %.3f\n",
+ indx->ID, outliter, outpt->vecno, outpt->score);
+ indx->ignore = YES;
+ }
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ printf ("number of samples after outlier removal: %d\n", nrows);
}
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
- if (outliername != NULL) fclose(outlfile) ;
+ if (outliername != NULL)
+ fclose (outlfile);
- m = numgtz(lambda, nrows) ;
+ m = numgtz (lambda, nrows);
/* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
-
-/** smartrel code */
- for (i=0; i<numeigs; i++) {
- y = sqrt(lambda[i]) ;
- vst(ww, evecs+i*nrows, y, nrows) ;
- subouter(XTX, ww, nrows) ;
- }
- free(tvecs) ;
-
- n = 0 ;
- ZALLOC(vecind, nrows*nrows/2, int) ;
- for (i=0; i<nrows; i++) {
- for (j=i+1; j<nrows; j++) {
- k = i*nrows + j ;
- y1 = XTX[i*nrows+i] ;
- y2 = XTX[j*nrows+j] ;
- y = XTX[k]/sqrt(y1*y2) ;
- y += 1/(double)(nrows-1);
- if (y<relthresh) continue ;
- vecind[n] = k ;
- evecs[n] = -y ;
- ++n ;
- }
- }
- free(XTX) ;
- if (n==0) {
- printf("## nothing above relthresh!\n") ;
- printf("##end of smartrel run\n") ;
- return 0 ;
- }
- ZALLOC(idperm, n, int) ;
- sortit(evecs, idperm, n) ;
- for (i=0; i<n; i++) {
- j = idperm[i] ;
- k = vecind[j] ;
- a = k/nrows ;
- b = k%nrows ;
- printf("rel: %20s ", xindlist[a] ->ID) ;
- printf("%20s ", xindlist[b] ->ID) ;
- printf(" %9.3f", -evecs[i]) ;
- printnl() ;
- }
-
- printf("##end of smartrel run\n") ;
- return 0 ;
+ if (m == 0)
+ fatalx ("no data\n");
+
+ /** smartrel code */
+ for (i = 0; i < numeigs; i++)
+ {
+ y = sqrt (lambda[i]);
+ vst (ww, evecs + i * nrows, y, nrows);
+ subouter (XTX, ww, nrows);
+ }
+ free (tvecs);
+
+ n = 0;
+ ZALLOC(vecind, nrows*nrows/2, int);
+ for (i = 0; i < nrows; i++)
+ {
+ for (j = i + 1; j < nrows; j++)
+ {
+ k = i * nrows + j;
+ y1 = XTX[i * nrows + i];
+ y2 = XTX[j * nrows + j];
+ y = XTX[k] / sqrt (y1 * y2);
+ y += 1 / (double) (nrows - 1);
+ if (y < relthresh)
+ continue;
+ vecind[n] = k;
+ evecs[n] = -y;
+ ++n;
+ }
+ }
+ free (XTX);
+ if (n == 0)
+ {
+ printf ("## nothing above relthresh!\n");
+ printf ("##end of smartrel run\n");
+ return 0;
+ }
+ ZALLOC(idperm, n, int);
+ sortit (evecs, idperm, n);
+ for (i = 0; i < n; i++)
+ {
+ j = idperm[i];
+ k = vecind[j];
+ a = k / nrows;
+ b = k % nrows;
+ printf ("rel: %20s ", xindlist[a]->ID);
+ printf ("%20s ", xindlist[b]->ID);
+ printf (" %9.3f", -evecs[i]);
+ printnl ();
+ }
+
+ printf ("##end of smartrel run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- phandle *ph ;
- int t ;
+ int i;
+ phandle *ph;
+ int t;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
+ if (parname == NULL)
+ {
+ fprintf (stderr, "no parameters\n");
+ return;
+ }
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getdbl(ph, "relthresh:", &relthresh) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
- getint(ph, "numchrom:", &numchrom) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "snpeigname:", &snpeigname);
+ getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "outputvecs:", &outputname);
+ getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
+ getstring (ph, "outputvals:", &outputvname);
+ getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "outliername:", &outliername);
+ getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
+ getstring (ph, "phylipname:", &phylipname);
+ getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
+ getstring (ph, "weightname:", &weightname);
+ getstring (ph, "fstdetailsname:", &fstdetailsname);
+ getdbl (ph, "relthresh:", &relthresh);
+ getint (ph, "numeigs:", &numeigs);
+ getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
+ getint (ph, "markerscore:", &markerscore);
+ getint (ph, "chisqmode:", &chisqmode);
+ getint (ph, "missingmode:", &missingmode);
+ getint (ph, "fancynorm:", &fancynorm);
+ getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
+ getint (ph, "dotpopsmode:", &dotpopsmode);
+ getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
+ getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
+ getint (ph, "altnormstyle:", &altnormstyle);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "popgenmode:", &altnormstyle);
+ getint (ph, "noxdata:", &noxdata);
+ t = -1;
+ getint (ph, "xdata:", &t);
+ if (t >= 0)
+ noxdata = 1 - t;
+ getint (ph, "nostatslim:", &nostatslim);
+ getint (ph, "popsizelimit:", &popsizelimit);
+ getint (ph, "minallelecnt:", &minallelecnt);
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "pubmean:", &pubmean);
+ getint (ph, "fstonly:", &fstonly);
+ getint (ph, "fsthiprecision:", &fsthiprec);
+
+ getint (ph, "ldregress:", &ldregress);
+ getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
+ getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
+ getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
+ getint (ph, "minleneig:", &nostatslim);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "familynames:", &familynames);
+
+ getint (ph, "numoutliter:", &numoutliter);
+ getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
+ getint (ph, "numoutleigs", &numoutleigs);
+ getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
+ getdbl (ph, "outlthresh:", &outlthresh);
+ getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
+ getdbl (ph, "blgsize:", &blgsize);
+
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getint (ph, "outputgroup:", &ogmode);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getstring (ph, "twxtabname:", &twxtabname);
+
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+ getint (ph, "killr2:", &killr2);
+ getint (ph, "numchrom:", &numchrom);
+
+ printf ("### THE INPUT PARAMETERS\n");
+ printf ("##PARAMETER NAME: VALUE\n");
+ writepars (ph);
}
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
+int
+fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean force missing to zero */
/* set up fancy norming */
{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- fatalx("(fvadjust) snp has no data\n") ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
+ double p, ynum, ysum, y, ymean, yfancy = 1.0;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ {
+ fatalx ("(fvadjust) snp has no data\n");
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ if (fancynorm)
+ {
+ p = 0.5 * ymean; // autosomes
+ if (altnormstyle == NO)
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ yfancy = 1.0 / sqrt (y);
+ }
+ if (fancy != NULL)
+ *fancy = yfancy;
+ return nmiss;
}
double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0
// perhaps should rewrite to put xa1 etc in arrays
{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ double *w1;
+ int *xt;
+ int i, k1, k2, k, n, x1, x2;
+ double ylike;
+ double ychi;
+ double *wmean;
+ int imax, imin, *isort;
+ static int ncall = 0;
+
+ char ss1[MAXSTR];
+ char ss2[MAXSTR];
+ double ans, ftail, ftailx, ansx;
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(w1, len + numeg, double);
+ ZALLOC(isort, numeg, int);
+ ZALLOC(xt, len, int);
+ strcpy (ss1, "");
+
+ calcmean (wmean, vec, len, xtypes, numeg);
+ if (pubmean)
+ {
+ copyarr (wmean, w1, numeg);
+ sortit (w1, isort, numeg);
+ printf ("%s:means\n", sss);
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ printf ("%20s ", eglist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
}
- }
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
+ vlmaxmin (wmean, numeg, &imax, &imin);
+ if (chisqmode)
+ {
+ ylike = anova1 (vec, len, xtypes, numeg);
+ ans = 2.0 * ylike;
}
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
+ else
+ {
+ ans = ftail = anova (vec, len, xtypes, numeg);
}
- ++ncall ;
-
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
+ ++ncall;
+
+ if (numeg > 2)
+ {
+ sprintf (ss2, "%s %s ", sss, "overall");
+ publishit (ss2, numeg - 1, ans);
+ printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
+ eglist[imax], wmean[imax]);
}
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ n = 0;
+ x1 = x2 = 0;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ if (k == k1)
+ {
+ w1[n] = vec[i];
+ xt[n] = 0;
+ ++n;
+ ++x1;
+ }
+ if (k == k2)
+ {
+ w1[n] = vec[i];
+ xt[n] = 1;
+ ++n;
+ ++x2;
+ }
+ }
+
+ if (x1 <= 1)
+ continue;
+ if (x2 <= 1)
+ continue;
+
+ ylike = anova1 (w1, n, xt, 2);
+ ychi = 2.0 * ylike;
+ chitot[k1 * numeg + k2] += ychi;
+ if (chisqmode)
+ {
+ ansx = ychi;
+ }
+ else
+ {
+ ansx = ftailx = anova (w1, n, xt, 2);
+ }
+
+ sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
+ publishit (ss2, 1, ansx);
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
}
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
}
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
+ free (w1);
+ free (xt);
+ free (wmean);
+ free (isort);
+ return ans;
}
-double anova(double *vec, int len, int *xtypes, int numeg)
+double
+anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, top, bot, ftail;
+ double *w0, *w1, *popsize, *wmean;
- static int ncall2 = 0 ;
+ static int ncall2 = 0;
- if (numeg >= len) fatalx("bad anova\n") ;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ if (numeg >= len)
+ fatalx ("bad anova\n");
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
+ /* debug */
+ if (numeg == 2)
+ {
+ ++ncall2;
+ for (i = 0; i < len; ++i)
+ {
+ if (ncall2 < 0)
+ break;
+ k = xtypes[i];
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
+ }
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ vvt (w1, wmean, wmean, numeg);
+ top = vdot (w1, popsize, numeg);
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
+ bot = asum2 (w1, len) / (double) (len - numeg);
+ bot *= (double) (numeg - 1);
+ ftail = rtlf (numeg - 1, len - numeg, top / bot);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ftail ;
+ return ftail;
}
-double anova1(double *vec, int len, int *xtypes, int numeg)
+double
+anova1 (double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
-
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
-
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
-
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ int i, k;
+ double y1, y2, ylike;
+ double *w0, *w1, *popsize, *wmean;
+
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
+
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
+ y1 = asum2 (w0, len) / (double) len;
+ y2 = asum2 (w1, len) / (double) len;
+ ylike = 0.5 * ((double) len) * log (y1 / y2);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ylike ;
+ return ylike;
}
-void publishit(char *sss, int df, double chi)
+void
+publishit (char *sss, int df, double chi)
{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
-
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f", ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
+ double tail;
+ char sshit[4];
+ char ss2[MAXSTR];
+ int i, n;
+ char cblank, cunder;
+ static int ncall = 0;
+
+ ++ncall;
+ cblank = ' ';
+ cunder = '_';
+ n = strlen (sss);
+
+ strcpy (ss2, sss);
+ for (i = 0; i < n; ++i)
+ {
+ if (ss2[i] == cblank)
+ ss2[i] = cunder;
+ }
+
+ if (chisqmode)
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
+ printf ("%40s %6d %9.3f", ss2, df, chi);
+ tail = rtlchsq (df, chi);
+ printf (" %12.6g", tail);
+ }
+ else
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %12s\n", "", "p-value");
+ printf ("%40s ", ss2);
+ tail = chi;
+ printf (" %12.6g", tail);
+ }
+ strcpy (sshit, "");
+ if (tail < pvhit)
+ strcpy (sshit, "***");
+ if (tail < pvjack)
+ strcpy (sshit, "+++");
+ printf (" %s", sshit);
+ printf ("\n");
}
void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
+ double *pp, *npp, val, yy;
+ int *popsize;
+ int i, j, k1, k2;
+
+ if (fstonly)
+ return;
+ ZALLOC(pp, numeg * numeg, double);
+ ZALLOC(npp, numeg * numeg, double);
+ popsize = xpopsize;
+
+ ivzero (popsize, numeg);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k1 = xtypes[i];
+ ++popsize[k1];
+ for (j = i + 1; j < nrows; j++)
+ {
+ k2 = xtypes[j];
+ if (k1 < 0)
+ fatalx ("bug\n");
+ if (k2 < 0)
+ fatalx ("bug\n");
+ if (k1 >= numeg)
+ fatalx ("bug\n");
+ if (k2 >= numeg)
+ fatalx ("bug\n");
+ val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
+ pp[k1 * numeg + k2] += val;
+ pp[k2 * numeg + k1] += val;
+ ++npp[k1 * numeg + k2];
+ ++npp[k2 * numeg + k1];
+ }
+ }
+ vsp (npp, npp, 1.0e-8, numeg * numeg);
+ vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- }
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
-
- free(pp) ;
- free(npp) ;
+ yy = trace (pp, numeg) / (double) numeg;
+ vst (pp, pp, 1.0 / yy, numeg * numeg);
+ printf ("\n## Average divergence between populations:");
+ if (numeg <= 10)
+ {
+ printf ("\n");
+ printf ("%10s", "");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %10s", eglist[k1]);
+ }
+ printf (" %10s", "popsize");
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ printf ("%10s", eglist[k2]);
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ }
+ printf (" %10d", popsize[k2]);
+ printf ("\n");
+ }
+ }
+ else
+ { // numeg >= 10
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ for (k1 = k2; k1 < numeg; ++k1)
+ {
+ printf ("dotp: %10s", eglist[k2]);
+ printf (" %10s", eglist[k1]);
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ printf (" %10d", popsize[k2]);
+ printf (" %10d", popsize[k1]);
+ printf ("\n");
+ }
+ }
+ }
+ printf ("\n");
+ printf ("\n");
+ fflush (stdout);
+
+ free (pp);
+ free (npp);
}
-void printxcorr(double *X, int nrows, Indiv **indxx)
+void
+printxcorr (double *X, int nrows, Indiv **indxx)
{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
+ int k1, k2, t;
+ double y1, y2, yy, rho;
+ Indiv *ind1, *ind2;
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
+ if (pcorrmode == NO)
+ return;
+ for (k1 = 0; k1 < nrows; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < nrows; ++k2)
+ {
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
+ ind1 = indxx[k1];
+ ind2 = indxx[k2];
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
+ t = strcmp (ind1->egroup, ind2->egroup);
+ if (pcpopsonly && (t != 0))
+ continue;
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
+ y1 = X[k1 * nrows + k1];
+ y2 = X[k2 * nrows + k2];
+ yy = X[k1 * nrows + k2];
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
+ rho = yy / sqrt (y1 * y2 + 1.0e-20);
+ printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
+ ind1->egroup, ind2->egroup, rho);
+ }
}
- }
}
-void clearld(double *ldmat, double *ldvv, int rsize, int n, int nclear)
+void
+clearld (double *ldmat, double *ldvv, int rsize, int n, int nclear)
{
- int i, j, lo, hi ;
+ int i, j, lo, hi;
- if (nclear>rsize) fatalx("bad nclear\n") ;
+ if (nclear > rsize)
+ fatalx ("bad nclear\n");
- lo = rsize-nclear ;
- hi = rsize-1 ;
+ lo = rsize - nclear;
+ hi = rsize - 1;
- for (i=lo; i<=hi; ++i) {
- vzero(ldvv+i*n, n) ;
- for (j=0; j<=hi; ++j) {
- ldmat[j*rsize+i] = ldmat[i*rsize+j] = 0.0 ;
- }
+ for (i = lo; i <= hi; ++i)
+ {
+ vzero (ldvv + i * n, n);
+ for (j = 0; j <= hi; ++j)
+ {
+ ldmat[j * rsize + i] = ldmat[i * rsize + j] = 0.0;
+ }
// force matrix non-singular
- ldmat[i*rsize+i] = 1.0e-8 ;
- }
+ ldmat[i * rsize + i] = 1.0e-8;
+ }
}
void
-ldreg(double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv,
- double *ldvv2, int rsize, int n)
+ldreg (double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv,
+ double *ldvv2, int rsize, int n)
/** ldmat2 is inner product matrix for last rsize columns on exit */
{
- int i, j, k1, k2 ;
- double *rr, *ans, *tt ;
- double y ;
-
- ZALLOC(rr, rsize, double) ;
- ZALLOC(ans, rsize, double) ;
- ZALLOC(tt, n, double) ;
-
- if (rsize>1)
- copyarr(ldvv, ldvv2+n, n*(rsize-1)) ;
- for (i=0; i<rsize-1 ; i++) {
- for (j=0; j<rsize-1 ; j++) {
- k1 = i*rsize+j ;
- k2 = (i+1)*rsize+j+1 ;
- ldmat2[k2] = ldmat[k1] ;
+ int i, j, k1, k2;
+ double *rr, *ans, *tt;
+ double y;
+
+ ZALLOC(rr, rsize, double);
+ ZALLOC(ans, rsize, double);
+ ZALLOC(tt, n, double);
+
+ if (rsize > 1)
+ copyarr (ldvv, ldvv2 + n, n * (rsize - 1));
+ for (i = 0; i < rsize - 1; i++)
+ {
+ for (j = 0; j < rsize - 1; j++)
+ {
+ k1 = i * rsize + j;
+ k2 = (i + 1) * rsize + j + 1;
+ ldmat2[k2] = ldmat[k1];
+ }
}
- }
- copyarr(vv, ldvv2, n) ;
- i = 0 ;
- for (j=0; j<rsize ; j++) {
- y = rr[j] = vdot(vv, ldvv+j*n, n) ;
- y = vdot(vv, ldvv2+j*n, n) ;
- if (j==0) y += 1.0e-6 ;
- ldmat2[i*rsize+j] = ldmat2[j*rsize+i] = y ;
- }
- solvit(ldmat, rr, rsize, ans) ; /* solve normal equations */
- copyarr(vv, vv2, n) ;
- for (i=0; i<rsize; i++) {
- vst(tt, ldvv+i*n, -ans[i], n) ;
- vvp(vv2, vv2, tt, n) ;
- }
- free(rr) ;
- free(ans) ;
- free(tt) ;
+ copyarr (vv, ldvv2, n);
+ i = 0;
+ for (j = 0; j < rsize; j++)
+ {
+ y = rr[j] = vdot (vv, ldvv + j * n, n);
+ y = vdot (vv, ldvv2 + j * n, n);
+ if (j == 0)
+ y += 1.0e-6;
+ ldmat2[i * rsize + j] = ldmat2[j * rsize + i] = y;
+ }
+ solvit (ldmat, rr, rsize, ans); /* solve normal equations */
+ copyarr (vv, vv2, n);
+ for (i = 0; i < rsize; i++)
+ {
+ vst (tt, ldvv + i * n, -ans[i], n);
+ vvp (vv2, vv2, tt, n);
+ }
+ free (rr);
+ free (ans);
+ free (tt);
}
-void fixwt(SNP **snpm, int nsnp, double val)
+void
+fixwt (SNP **snpm, int nsnp, double val)
{
- int k ;
- SNP *cupt ;
+ int k;
+ SNP *cupt;
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ cupt->weight = val;
+ }
}
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ static int ncall = 0;
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
+ ++ncall;
+ ZALLOC(rawcol, nrows, int);
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ getrawcol (rawcol, cupt, xindex, nrows);
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ ivzero (c1, 2);
+ ivzero (c2, 2);
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
+ if (ncall < 0)
+ {
+ printf ("qq2\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
- *estn = en ;
- *estd = ed ;
-
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ return 0.0;
+ }
- free(rawcol) ;
- return z + zz ;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
-}
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
+ ed = en;
+ ed += h1;
+ ed += h2;
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+ *estn = en;
+ *estd = ed;
+
+ free (rawcol);
+ return z + zz;
+
+}
+
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ int **ccc;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = ccc[i][0];
+ if (ncall < 1000)
+ {
// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
+ }
+
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, ccc[i], 2);
}
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ if (ncall < 0)
+ {
+ printf ("qqq\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 1.1) || (zz < 1.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
+
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ ed = en;
+ ed += h1;
+ ed += h2;
- *estn = en ;
- *estd = ed ;
-
+ *estn = en;
+ *estd = ed;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols)
{
// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
-
-
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<=10; ++k) {
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
+ double *xpt, y, yscal, *snpsc;
+ int i, j, k, kmax, kmin;
+ SNP * cupt;
+ FILE *fff;
+ for (j = 0; j < numeigs; ++j)
+ {
+ xpt = ffvecs + j * ncols;
+ y = asum2 (xpt, ncols);
+ yscal = (double) ncols / y;
+ yscal = sqrt (yscal);
+ vst (xpt, xpt, yscal, ncols);
+ }
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
+ ZALLOC(snpsc, ncols, double);
+ vclear (snpsc, -99999, ncols);
+ for (j = 0; j < numeigs; ++j)
+ {
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
+ y = ffvecs[j * ncols + i];
+ snpsc[i] = fabs (y);
+ }
+ for (k = 0; k <= 10; ++k)
+ {
+ vlmaxmin (snpsc, ncols, &kmax, &kmin);
+ cupt = xsnplist[kmax];
+ printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
+ cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
+ snpsc[kmax] = -1.0;
+ }
+ }
+ free (snpsc);
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
+ if (snpeigname == NULL)
+ return;
+ openit (snpeigname, &fff, "w");
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
+ fprintf (fff, "%20s", cupt->ID);
+ fprintf (fff, " %2d", cupt->chrom);
+ fprintf (fff, " %12d", nnint (cupt->physpos));
- fclose(fff) ;
+ for (j = 0; j < numeigs; ++j)
+ {
+ fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
+ }
+ fprintf (fff, "\n");
+ }
+
+ fclose (fff);
}
void
-getcolxz(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
+getcolxz (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
{
- int j, n, g ;
- double pmean, yfancy ;
- int *rawcol ;
- int c0, c1 ;
-
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) continue ;
- c0 += g ;
- c1 += 2-g ;
- }
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- *n0 = c0 ;
- *n1 = c1 ;
+ int j, n, g;
+ double pmean, yfancy;
+ int *rawcol;
+ int c0, c1;
+
+ c0 = c1 = 0;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ continue;
+ c0 += g;
+ c1 += 2 - g;
+ }
+ floatit (xcol, rawcol, nrows);
+
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+ *n0 = c0;
+ *n1 = c1;
}
/** this is the code to parallelize */
void
-domult(double *tvecs, double *tblock, int numrow, int len)
+domult (double *tvecs, double *tblock, int numrow, int len)
{
- int i ;
- double ycheck ;
- vzero(tvecs, len*len) ;
- for (i=0; i<numrow; i++) {
- ycheck = asum(tblock+i*len, len) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n") ;
- addoutersym(tvecs, tblock+i*len, len) ;
- }
+ int i;
+ double ycheck;
+ vzero (tvecs, len * len);
+ for (i = 0; i < numrow; i++)
+ {
+ ycheck = asum (tblock + i * len, len);
+ if (fabs (ycheck) > .00001)
+ fatalx ("bad ycheck\n");
+ addoutersym (tvecs, tblock + i * len, len);
+ }
}
void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
-
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
-
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
-
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
-}
+ int n;
+ double pmean, yfancy;
+ int *rawcol;
+
+ if (xmean != NULL)
+ {
+ xmean[col] = xfancy[col] = 0.0;
+ }
+
+ if (cupt->ignore)
+ {
+ vzero (xcol, nrows);
+ return;
+ }
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+}
diff --git a/src/eigensrc/smartsubs.c b/src/eigensrc/smartsubs.c
index 13ab423..bb1cc03 100644
--- a/src/eigensrc/smartsubs.c
+++ b/src/eigensrc/smartsubs.c
@@ -1,90 +1,105 @@
#include "qpsubs.h"
#include "eigsubs.h"
#include "smartsubs.h"
-extern int fancynorm, verbose, plotmode, outnum ;
-extern FILE *fstdetails ;
+extern int fancynorm, verbose, plotmode, outnum;
+extern FILE *fstdetails;
// static Indiv **indm ;
// static void wjackestx(double *est, double *sig, double mean, double *jmean, double *jwt, int g) ;
// static void wjackvestx(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g) ;
-static int outliermode = 0 ;
+static int outliermode = 0;
-void setoutliermode(int mode)
+void
+setoutliermode (int mode)
{
- outliermode = mode ;
+ outliermode = mode;
}
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo)
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo)
{
-/* badlist contains list of outliers */
- double *ww, *w2, y1 , y2, yy, zz ;
- int *vbad ;
- int i, j ;
- int nbad = 0 ;
- OUTLINFO *outpt;
+ /* badlist contains list of outliers */
+ double *ww, *w2, y1, y2, yy, zz;
+ int *vbad;
+ int i, j;
+ int nbad = 0;
+ OUTLINFO *outpt;
- if (outliermode > 1) return 0;
- if (n<3) return 0;
- ZALLOC(ww, n, double) ;
- ZALLOC(vbad, n, int) ;
- for(j=0;j<n;j++) {
- outpt = outinfo[j];
- outpt->vecno = -1;
- }
- for (i=0; i<neigs; ++i) {
- copyarr(evecs+i*n, ww, n) ;
- if (outliermode == 0) {
- y1 = asum(ww, n) / (double) n ;
- vsp(ww, ww, -y1, n) ;
- y2 = asum2(ww, n) / (double) n ;
- y2 = sqrt(y2) ;
- vst(ww, ww, 1.0/y2, n) ;
+ if (outliermode > 1)
+ return 0;
+ if (n < 3)
+ return 0;
+ ZALLOC(ww, n, double);
+ ZALLOC(vbad, n, int);
+ for (j = 0; j < n; j++)
+ {
+ outpt = outinfo[j];
+ outpt->vecno = -1;
+ }
+ for (i = 0; i < neigs; ++i)
+ {
+ copyarr (evecs + i * n, ww, n);
+ if (outliermode == 0)
+ {
+ y1 = asum (ww, n) / (double) n;
+ vsp (ww, ww, -y1, n);
+ y2 = asum2 (ww, n) / (double) n;
+ y2 = sqrt (y2);
+ vst (ww, ww, 1.0 / y2, n);
- for (j=0; j<n; j++) {
- if (fabs(ww[j])>thresh) {
- vbad[j] = 1 ;
- outpt = outinfo[j];
- if (outpt->vecno < 0) {
- outpt->vecno = i;
- outpt->score = ww[j];
- }
+ for (j = 0; j < n; j++)
+ {
+ if (fabs (ww[j]) > thresh)
+ {
+ vbad[j] = 1;
+ outpt = outinfo[j];
+ if (outpt->vecno < 0)
+ {
+ outpt->vecno = i;
+ outpt->score = ww[j];
+ }
+ }
+ }
+ }
+ if (outliermode == 1)
+ {
+ ZALLOC(w2, n, double);
+ for (j = 0; j < n; j++)
+ {
+ yy = ww[j];
+ ww[j] = 0;
+ y1 = asum (ww, n) / (double) (n - 1);
+ vsp (w2, ww, -y1, n);
+ w2[j] = 0;
+ y2 = asum2 (w2, n) / (double) n;
+ y2 = sqrt (y2);
+ zz = yy - y1;
+ zz /= y2;
+ if (fabs (zz) > thresh)
+ {
+ vbad[j] = 1;
+ outpt = outinfo[j];
+ if (outpt->vecno < 0)
+ {
+ outpt->vecno = i;
+ outpt->score = zz;
+ }
+ }
+ ww[j] = yy;
+ }
+ free (w2);
+ }
}
- }
- }
- if (outliermode == 1) {
- ZALLOC(w2, n, double) ;
- for (j=0; j<n; j++) {
- yy = ww[j] ;
- ww[j] = 0 ;
- y1 = asum(ww, n) / (double) (n-1) ;
- vsp(w2, ww, -y1, n) ;
- w2[j] = 0 ;
- y2 = asum2(w2, n) / (double) n ;
- y2 = sqrt(y2) ;
- zz = yy-y1 ;
- zz /= y2 ;
- if (fabs(zz)>thresh) {
- vbad[j] = 1 ;
- outpt = outinfo[j];
- if (outpt->vecno < 0) {
- outpt->vecno = i;
- outpt->score = zz ;
- }
+ for (j = 0; j < n; j++)
+ {
+ if (vbad[j] == 1)
+ {
+ badlist[nbad] = j;
+ ++nbad;
+ }
}
- ww[j] = yy ;
- }
- free(w2) ;
- }
- }
- for (j=0; j<n; j++) {
- if (vbad[j] == 1) {
- badlist[nbad] = j ;
- ++nbad ;
- }
- }
- free(ww) ;
- free(vbad) ;
- return nbad ;
+ free (ww);
+ free (vbad);
+ return nbad;
}
diff --git a/src/eigensrc/twstats.c b/src/eigensrc/twstats.c
index 0dee5ca..d580391 100644
--- a/src/eigensrc/twstats.c
+++ b/src/eigensrc/twstats.c
@@ -5,143 +5,144 @@
#include <nicklib.h>
#include <getpars.h>
-int verbose = NO ;
-double nval = -1 ;
+int verbose = NO;
+double nval = -1;
-char *iname = NULL ;
-char *parname = NULL ;
-char *oname = NULL ;
+char *iname = NULL;
+char *parname = NULL;
+char *oname = NULL;
-char *twxtab = NULL ;
+char *twxtab = NULL;
-/**
-The Broad Institute
-SOFTWARE COPYRIGHT NOTICE AGREEMENT
-This software and its documentation are copyright <2006> by the
-Broad Institute/Massachusetts Institute of Technology. All rights are
-reserved.
-
-This software is supplied without any warranty or guaranteed support
-whatsoever. Neither the Broad Institute nor MIT can be responsible for
-its use, misuse, or functionality.
-*/
-
-void readcommands(int argc, char **argv) ;
+void
+readcommands (int argc, char **argv);
#define VERSION "1000"
-int minleneig = 10 ;
-
+int minleneig = 10;
-int
-main (int argc , char **argv)
+int
+main (int argc, char **argv)
{
- FILE *ofile ;
- int nlambda = 0 ;
- int i, m ;
- double zn, zvar, tw, tail ;
- double *xx[0], *lambda ;
-
- readcommands(argc, argv) ;
- settwxtable(twxtab) ;
-
- if (oname == NULL) ofile = stdout ;
- else openit(oname, &ofile, "w") ;
-
- if (iname==NULL) fatalx("i paraameter compulsory\n") ;
- nlambda = numlines(iname) ;
- ZALLOC(lambda, nlambda, double) ;
- xx[0] = lambda ;
- nlambda = getxx(xx, nlambda, 1, iname) ;
- vst(lambda, lambda, -1.0, nlambda) ;
- sortit(lambda, NULL, nlambda) ;
- vst(lambda, lambda, -1.0, nlambda) ;
- m = numgtz(lambda, nlambda) ;
-
- fprintf(ofile,"%4s %12s", "#N", "eigenvalue") ;
- fprintf(ofile,"%12s", "difference") ;
- fprintf(ofile," %9s %12s", "twstat", "p-value") ;
- fprintf(ofile," %9s", "effect. n") ;
- fprintf(ofile,"\n");
-
- for (i=0; i<m; ++i) {
-
- zn = nval ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, minleneig) ;
- fprintf(ofile,"%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) fprintf(ofile, "%12s", "NA") ;
- else fprintf(ofile,"%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) fprintf(ofile, " %9.3f %12.6g", tw, tail) ;
- else fprintf(ofile, " %9s %12s", "NA", "NA") ;
- if (zn>0.0) {
- fprintf(ofile, " %9.3f", zn) ;
- }
- else {
- fprintf(ofile, " %9s", "NA") ;
- }
- fprintf(ofile, "\n") ;
- }
- return 0;
+ FILE *ofile;
+ int nlambda = 0;
+ int i, m;
+ double zn, zvar, tw, tail;
+ double *xx[0], *lambda;
+
+ readcommands (argc, argv);
+ settwxtable (twxtab);
+
+ if (oname == NULL)
+ ofile = stdout;
+ else
+ openit (oname, &ofile, "w");
+
+ if (iname == NULL)
+ fatalx ("i paraameter compulsory\n");
+ nlambda = numlines (iname);
+ ZALLOC(lambda, nlambda, double);
+ xx[0] = lambda;
+ nlambda = getxx (xx, nlambda, 1, iname);
+ vst (lambda, lambda, -1.0, nlambda);
+ sortit (lambda, NULL, nlambda);
+ vst (lambda, lambda, -1.0, nlambda);
+ m = numgtz (lambda, nlambda);
+
+ fprintf (ofile, "%4s %12s", "#N", "eigenvalue");
+ fprintf (ofile, "%12s", "difference");
+ fprintf (ofile, " %9s %12s", "twstat", "p-value");
+ fprintf (ofile, " %9s", "effect. n");
+ fprintf (ofile, "\n");
+
+ for (i = 0; i < m; ++i)
+ {
+
+ zn = nval;
+ tail = dotwcalc (lambda + i, m - i, &tw, &zn, &zvar, minleneig);
+ fprintf (ofile, "%4d %12.6f", i + 1, lambda[i]);
+ if (i == 0)
+ fprintf (ofile, "%12s", "NA");
+ else
+ fprintf (ofile, "%12.6f", lambda[i] - lambda[i - 1]);
+ if (tail >= 0.0)
+ fprintf (ofile, " %9.3f %12.6g", tw, tail);
+ else
+ fprintf (ofile, " %9s %12s", "NA", "NA");
+ if (zn > 0.0)
+ {
+ fprintf (ofile, " %9.3f", zn);
+ }
+ else
+ {
+ fprintf (ofile, " %9s", "NA");
+ }
+ fprintf (ofile, "\n");
+ }
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- char *parname = NULL ;
- phandle *ph ;
+ int i;
+ char *parname = NULL;
+ phandle *ph;
- while ((i = getopt (argc, argv, "i:o:p:n:m:t:V")) != -1) {
+ while ((i = getopt (argc, argv, "i:o:p:n:m:t:V")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'i':
- iname = strdup(optarg) ;
- break;
+ case 'i':
+ iname = strdup (optarg);
+ break;
- case 'o':
- oname = strdup(optarg) ;
- break;
+ case 'o':
+ oname = strdup (optarg);
+ break;
- case 't':
- twxtab = strdup(optarg) ;
- break;
+ case 't':
+ twxtab = strdup (optarg);
+ break;
- case 'n':
- nval = atof(optarg) ;
- break;
+ case 'n':
+ nval = atof (optarg);
+ break;
- case 'm':
- minleneig = atoi(optarg) ;
- break;
+ case 'm':
+ minleneig = atoi (optarg);
+ break;
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
- if (parname == NULL) return ;
+ if (parname == NULL)
+ return;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
- getstring(ph, "input:", &iname) ;
- getstring(ph, "output:", &oname) ;
- getdbl(ph, "nval:", &nval) ;
- getint(ph, "minleneig:", &minleneig) ;
+ getstring (ph, "input:", &iname);
+ getstring (ph, "output:", &oname);
+ getdbl (ph, "nval:", &nval);
+ getint (ph, "minleneig:", &minleneig);
- writepars(ph);
- closepars(ph) ;
+ writepars (ph);
+ closepars (ph);
}
diff --git a/src/eigx.c b/src/eigx.c
index adbcf15..845e1f6 100644
--- a/src/eigx.c
+++ b/src/eigx.c
@@ -25,186 +25,229 @@ typedef long int __CLPK_integer;
#endif
typedef double __CLPK_doublereal;
-int dspev_(char* jobz, char* uplo, __CLPK_integer* n, __CLPK_doublereal* ap,
- __CLPK_doublereal* w, __CLPK_doublereal* z__, __CLPK_integer* ldz,
- __CLPK_doublereal* work, __CLPK_integer* info);
+int
+dspev_ (char* jobz, char* uplo, __CLPK_integer* n, __CLPK_doublereal* ap,
+__CLPK_doublereal* w, __CLPK_doublereal* z__, __CLPK_integer* ldz,
+__CLPK_doublereal* work, __CLPK_integer* info);
-int dpotrf_(char* uplo, __CLPK_integer* n, __CLPK_doublereal* a,
- __CLPK_integer* lda, __CLPK_integer* info);
+int
+dpotrf_ (char* uplo, __CLPK_integer* n, __CLPK_doublereal* a,
+__CLPK_integer* lda, __CLPK_integer* info);
-int dgetrf_(__CLPK_integer* m, __CLPK_integer* n, __CLPK_doublereal* a,
- __CLPK_integer* lda, __CLPK_integer* ipiv, __CLPK_integer* info);
+int
+dgetrf_ (__CLPK_integer* m, __CLPK_integer* n, __CLPK_doublereal* a,
+__CLPK_integer* lda, __CLPK_integer* ipiv, __CLPK_integer* info);
-int dgetri_(__CLPK_integer* n, __CLPK_doublereal* a, __CLPK_integer* lda,
- __CLPK_integer* ipiv, __CLPK_doublereal* work,
- __CLPK_integer* lwork, __CLPK_integer* info);
+int
+dgetri_ (__CLPK_integer* n, __CLPK_doublereal* a, __CLPK_integer* lda,
+__CLPK_integer* ipiv, __CLPK_doublereal* work,
+__CLPK_integer* lwork, __CLPK_integer* info);
-int dgetrs_(char* trans, __CLPK_integer* n, __CLPK_integer* nrhs,
- __CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_integer* ipiv,
- __CLPK_doublereal* b, __CLPK_integer* ldb, __CLPK_integer* info);
+int
+dgetrs_ (char* trans, __CLPK_integer* n, __CLPK_integer* nrhs,
+__CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_integer* ipiv,
+__CLPK_doublereal* b, __CLPK_integer* ldb, __CLPK_integer* info);
-int dsygv_(__CLPK_integer* itype, char* jobz, char* uplo, __CLPK_integer* n,
- __CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_doublereal* b,
- __CLPK_integer* ldb, __CLPK_doublereal* w, __CLPK_doublereal* work,
- __CLPK_integer* lwork, __CLPK_integer* info);
+int
+dsygv_ (__CLPK_integer* itype, char* jobz, char* uplo, __CLPK_integer* n,
+__CLPK_doublereal* a, __CLPK_integer* lda, __CLPK_doublereal* b,
+__CLPK_integer* ldb, __CLPK_doublereal* w, __CLPK_doublereal* work,
+__CLPK_integer* lwork, __CLPK_integer* info);
#endif // end !_WIN32
#endif // end !__APPLE__
-void mem_error() {
- fprintf(stderr, "CM\n");
- exit(1);
+void
+mem_error ()
+{
+ fprintf (stderr, "CM\n");
+ exit (1);
}
-void inverse_error(char* procname, int info) {
- if (info < 0) {
- fprintf(stderr, "error (%s): illegal argument %d\n", procname, -info);
- } else {
- fprintf(stderr, "error (%s): singular matrix %d\n", procname, info);
- }
- exit(1);
+void
+inverse_error (char* procname, int info)
+{
+ if (info < 0)
+ {
+ fprintf (stderr, "error (%s): illegal argument %d\n", procname, -info);
+ }
+ else
+ {
+ fprintf (stderr, "error (%s): singular matrix %d\n", procname, info);
+ }
+ exit (1);
}
-void eigx_(double* pmat, double* ev, __CLPK_integer* n) {
- char jobz = 'N';
- char uplo = 'L';
- __CLPK_integer ldz = *n;
- __CLPK_integer info;
- double* z;
- double* work;
- z = (double*)malloc(ldz * ldz * sizeof(double));
- if (!z) {
- mem_error();
- }
- work = (double*)malloc(3 * ldz * sizeof(double));
- if (!work) {
+void
+eigx_ (double* pmat, double* ev, __CLPK_integer* n)
+ {
+ char jobz = 'N';
+ char uplo = 'L';
+ __CLPK_integer ldz = *n;
+ __CLPK_integer info;
+ double* z;
+ double* work;
+ z = (double*)malloc(ldz * ldz * sizeof(double));
+ if (!z)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(3 * ldz * sizeof(double));
+ if (!work)
+ {
+ free(z);
+ mem_error();
+ }
+ dspev_(&jobz, &uplo, n, pmat, ev, z, &ldz, work, &info);
free(z);
- mem_error();
- }
- dspev_(&jobz, &uplo, n, pmat, ev, z, &ldz, work, &info);
- free(z);
- free(work);
- if (info) {
+ free(work);
+ if (info)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "INFO: %d\n", info);
+ fprintf(stderr, "INFO: %d\n", info);
#else
- fprintf(stderr, "INFO: %ld\n", info);
+ fprintf(stderr, "INFO: %ld\n", info);
#endif
- exit(1);
+ exit(1);
+ }
}
-}
-void eigxv_(double* pmat, double* eval, double* evec, __CLPK_integer* n) {
- char jobz = 'V';
- char uplo = 'L';
- __CLPK_integer ldz = *n;
- __CLPK_integer info;
- double* work = (double*)malloc(3 * ldz * sizeof(double));
- if (!work) {
- mem_error();
- }
- dspev_(&jobz, &uplo, n, pmat, eval, evec, &ldz, work, &info);
- free(work);
- if (info) {
+void
+eigxv_ (double* pmat, double* eval, double* evec, __CLPK_integer* n)
+ {
+ char jobz = 'V';
+ char uplo = 'L';
+ __CLPK_integer ldz = *n;
+ __CLPK_integer info;
+ double* work = (double*)malloc(3 * ldz * sizeof(double));
+ if (!work)
+ {
+ mem_error();
+ }
+ dspev_(&jobz, &uplo, n, pmat, eval, evec, &ldz, work, &info);
+ free(work);
+ if (info)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "INFO: %d\n", info);
+ fprintf(stderr, "INFO: %d\n", info);
#else
- fprintf(stderr, "INFO: %ld\n", info);
+ fprintf(stderr, "INFO: %ld\n", info);
#endif
- exit(1);
+ exit(1);
+ }
}
-}
-void cdc_(double* pmat, __CLPK_integer* n) {
- char uplo = 'L';
- __CLPK_integer lda = *n;
- __CLPK_integer info;
- dpotrf_(&uplo, n, pmat, &lda, &info);
- if (info) {
- if (info < 0) {
+void
+cdc_ (double* pmat, __CLPK_integer* n)
+ {
+ char uplo = 'L';
+ __CLPK_integer lda = *n;
+ __CLPK_integer info;
+ dpotrf_(&uplo, n, pmat, &lda, &info);
+ if (info)
+ {
+ if (info < 0)
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "error (CDC): illegal argument %d\n", -info);
+ fprintf(stderr, "error (CDC): illegal argument %d\n", -info);
#else
- fprintf(stderr, "error (CDC): illegal argument %ld\n", -info);
+ fprintf(stderr, "error (CDC): illegal argument %ld\n", -info);
#endif
- } else {
+ }
+ else
+ {
#if __LP64__ || _WIN32
- fprintf(stderr, "error (CDC): minor not positive definite %d\n", info);
+ fprintf(stderr, "error (CDC): minor not positive definite %d\n", info);
#else
- fprintf(stderr, "error (CDC): minor not positive definite %ld\n", info);
+ fprintf(stderr, "error (CDC): minor not positive definite %ld\n", info);
#endif
- }
- exit(1);
+ }
+ exit(1);
+ }
}
-}
-void inverse_(double* pmat, __CLPK_integer* n) {
- __CLPK_integer lwork = (*n) * (*n);
- __CLPK_integer info;
- __CLPK_integer* ipiv;
- double* work;
- ipiv = (__CLPK_integer*)malloc((*n) * sizeof(__CLPK_integer));
- if (!ipiv) {
- mem_error();
- }
- work = (double*)malloc(lwork * sizeof(double));
- if (!work) {
- free(ipiv);
- mem_error();
- }
- dgetrf_(n, n, pmat, n, ipiv, &info);
- if (info) {
+void
+inverse_ (double* pmat, __CLPK_integer* n)
+ {
+ __CLPK_integer lwork = (*n) * (*n);
+ __CLPK_integer info;
+ __CLPK_integer* ipiv;
+ double* work;
+ ipiv = (__CLPK_integer*)malloc((*n) * sizeof(__CLPK_integer));
+ if (!ipiv)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(lwork * sizeof(double));
+ if (!work)
+ {
+ free(ipiv);
+ mem_error();
+ }
+ dgetrf_(n, n, pmat, n, ipiv, &info);
+ if (info)
+ {
+ free(ipiv);
+ free(work);
+ inverse_error("INVERSE", info);
+ exit(1);
+ }
+ dgetri_(n, pmat, n, ipiv, work, &lwork, &info);
free(ipiv);
free(work);
- inverse_error("INVERSE", info);
- exit(1);
- }
- dgetri_(n, pmat, n, ipiv, work, &lwork, &info);
- free(ipiv);
- free(work);
- if (info) {
- inverse_error("INVERSE", info);
+ if (info)
+ {
+ inverse_error("INVERSE", info);
+ }
}
-}
-void solve_(double* pmat, double* v, __CLPK_integer* n) {
- __CLPK_integer ldb = *n;
- char trans = 'N';
- __CLPK_integer nrhs = 1;
- double* work;
- __CLPK_integer* ipiv;
- __CLPK_integer info;
- ipiv = (__CLPK_integer*)malloc(ldb * sizeof(__CLPK_integer));
- if (!ipiv) {
- mem_error();
- }
- work = (double*)malloc(ldb * ldb * sizeof(double));
- if (!work) {
- free(ipiv);
- mem_error();
- }
- dgetrf_(n, n, pmat, n, ipiv, &info);
- if (info) {
+void
+solve_ (double* pmat, double* v, __CLPK_integer* n)
+ {
+ __CLPK_integer ldb = *n;
+ char trans = 'N';
+ __CLPK_integer nrhs = 1;
+ double* work;
+ __CLPK_integer* ipiv;
+ __CLPK_integer info;
+ ipiv = (__CLPK_integer*)malloc(ldb * sizeof(__CLPK_integer));
+ if (!ipiv)
+ {
+ mem_error();
+ }
+ work = (double*)malloc(ldb * ldb * sizeof(double));
+ if (!work)
+ {
+ free(ipiv);
+ mem_error();
+ }
+ dgetrf_(n, n, pmat, n, ipiv, &info);
+ if (info)
+ {
+ free(ipiv);
+ free(work);
+ inverse_error("SOLVE", info);
+ }
+ dgetrs_(&trans, n, &nrhs, pmat, n, ipiv, v, &ldb, &info);
free(ipiv);
free(work);
- inverse_error("SOLVE", info);
+ if (info < 0)
+ {
+ inverse_error("SOLVE", info);
+ }
}
- dgetrs_(&trans, n, &nrhs, pmat, n, ipiv, v, &ldb, &info);
- free(ipiv);
- free(work);
- if (info < 0) {
- inverse_error("SOLVE", info);
- }
-}
-void geneigsolve_(double* pmat, double* qmat, double* eval, __CLPK_integer* n) {
- __CLPK_integer lwork = (*n) * (*n);
- double* work = (double*)malloc(lwork * sizeof(double));
- __CLPK_integer wood_elf = 1; // Sameer Merchant memorial temporary variable
- __CLPK_integer info;
- if (!work) {
- mem_error();
- }
- dsygv_(&wood_elf, "V", "U", n, pmat, n, qmat, n, eval, work, &lwork, &info);
+void
+geneigsolve_ (double* pmat, double* qmat, double* eval, __CLPK_integer* n)
+ {
+ __CLPK_integer lwork = (*n) * (*n);
+ double* work = (double*)malloc(lwork * sizeof(double));
+ __CLPK_integer wood_elf = 1; // Sameer Merchant memorial temporary variable
+ __CLPK_integer info;
+ if (!work)
+ {
+ mem_error();
+ }
+ dsygv_(&wood_elf, "V", "U", n, pmat, n, qmat, n, eval, work, &lwork, &info);
free(work);
if (info && (info <= 2 * (*n))) {
if (info < 0) {
diff --git a/src/exclude.c b/src/exclude.c
index c5f14e7..aca0113 100644
--- a/src/exclude.c
+++ b/src/exclude.c
@@ -4,7 +4,10 @@
#define MAXRGN 1000
-void excluderegions(char *xregionname, SNP **snps, int nsnps, char *deletesnpoutname) {
+void
+excluderegions (char *xregionname, SNP **snps, int nsnps,
+ char *deletesnpoutname)
+{
FILE *fp;
int chr[MAXRGN];
@@ -15,84 +18,101 @@ void excluderegions(char *xregionname, SNP **snps, int nsnps, char *deletesnpout
char *spt[MAXFF];
int nsplit, nrgn, i, j;
- if ( (fp = fopen(xregionname, "r")) == NULL ) {
- printf("excluderegions: can't open file %s\n", xregionname);
- return;
- }
+ if ((fp = fopen (xregionname, "r")) == NULL)
+ {
+ printf ("excluderegions: can't open file %s\n", xregionname);
+ return;
+ }
- for(i=0;i<MAXRGN;i++) {
+ for (i = 0; i < MAXRGN; i++)
+ {
- if ( fgets(line,MAXSTR,fp) == NULL )
- break;
+ if (fgets (line, MAXSTR, fp) == NULL)
+ break;
- nsplit = splitup(line, spt, MAXFF);
- if ( nsplit != 3 )
- continue;
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit != 3)
+ continue;
- chr[i] = atoi(spt[0]);
- lo[i] = atoi(spt[1]);
- hi[i] = atoi(spt[2]);
+ chr[i] = atoi (spt[0]);
+ lo[i] = atoi (spt[1]);
+ hi[i] = atoi (spt[2]);
- }
- fclose(fp);
+ }
+ fclose (fp);
nrgn = i;
-
- for(i=0;i<nsnps;i++) {
- SNP *cupt = snps[i];
- for(j=0;j<nrgn;j++) {
- if ( cupt->chrom == chr[j] && cupt->physpos >= lo[j] && cupt->physpos <= hi[j] ) {
- cupt->ignore = YES;
- if ( deletesnpoutname != NULL ) {
- logdeletedsnp(cupt->ID, "xregion",deletesnpoutname);
+
+ for (i = 0; i < nsnps; i++)
+ {
+ SNP *cupt = snps[i];
+ for (j = 0; j < nrgn; j++)
+ {
+ if (cupt->chrom == chr[j] && cupt->physpos >= lo[j]
+ && cupt->physpos <= hi[j])
+ {
+ cupt->ignore = YES;
+ if (deletesnpoutname != NULL)
+ {
+ logdeletedsnp (cupt->ID, "xregion", deletesnpoutname);
+ }
+ }
}
- }
}
- }
return;
}
-void hwfilter(SNP **snps, int nsnps, int nindiv, double nhwfilter, char *deletesnpoutname) {
+void
+hwfilter (SNP **snps, int nsnps, int nindiv, double nhwfilter,
+ char *deletesnpoutname)
+{
int i, k;
-
- for(i=0;i<nsnps;i++) {
- int num = 0, den = 0, het = 0, n0 = 0, n1 = 0, n2 = 0, nsamples;
- double p, Q, stdv;
- SNP *cupt = snps[i];
-
- for(k=0;k<nindiv;k++) {
- int g = getgtypes(cupt, k);
- if ( g >=0 ) {
- num += g;
- den += 2;
- }
- if ( g == 1 ) {
- het++;
- n1++;
- }
- else if ( g == 0 ) {
- n0++;
- }
- else if ( g == 2 ) {
- n2++;
- }
- }
- if ( (nsamples=den/2) == 0 )
- continue;
- p = (double) num/den;
- Q = 2*p*(1-p);
- stdv = sqrt(Q*(1-Q)/nsamples);
- if ( fabs( (double)het/nsamples - Q ) > nhwfilter*stdv ) {
- printf("SNP %s removed by Hardy-Weinberg filter\n", cupt->ID);
- cupt->ignore = YES;
- if ( deletesnpoutname != NULL ) {
- logdeletedsnp(cupt->ID, "hwfilt",deletesnpoutname);
- }
- }
- }
+ for (i = 0; i < nsnps; i++)
+ {
+ int num = 0, den = 0, het = 0, n0 = 0, n1 = 0, n2 = 0, nsamples;
+ double p, Q, stdv;
+ SNP *cupt = snps[i];
+
+ for (k = 0; k < nindiv; k++)
+ {
+ int g = getgtypes (cupt, k);
+ if (g >= 0)
+ {
+ num += g;
+ den += 2;
+ }
+ if (g == 1)
+ {
+ het++;
+ n1++;
+ }
+ else if (g == 0)
+ {
+ n0++;
+ }
+ else if (g == 2)
+ {
+ n2++;
+ }
+ }
+ if ((nsamples = den / 2) == 0)
+ continue;
+ p = (double) num / den;
+ Q = 2 * p * (1 - p);
+ stdv = sqrt (Q * (1 - Q) / nsamples);
+ if (fabs ((double) het / nsamples - Q) > nhwfilter * stdv)
+ {
+ printf ("SNP %s removed by Hardy-Weinberg filter\n", cupt->ID);
+ cupt->ignore = YES;
+ if (deletesnpoutname != NULL)
+ {
+ logdeletedsnp (cupt->ID, "hwfilt", deletesnpoutname);
+ }
+ }
+ }
}
diff --git a/src/gval.c b/src/gval.c
index b9a43f2..68b341f 100644
--- a/src/gval.c
+++ b/src/gval.c
@@ -25,7 +25,7 @@ static double **gtable;
void
setgval (SNP ** xsnps, int nrows, Indiv ** indivmarkers, int numindivs,
- int *xindex, int *xtypes, int ncols)
+ int *xindex, int *xtypes, int ncols)
{
double *cc;
@@ -46,8 +46,8 @@ setgval (SNP ** xsnps, int nrows, Indiv ** indivmarkers, int numindivs,
{
if (xxindex[i] < xxindex[i - 1])
{
- fprintf(stderr, "xindex not sorted\n");
- exit(1);
+ fprintf (stderr, "xindex not sorted\n");
+ exit (1);
}
}
@@ -70,16 +70,16 @@ setgval (SNP ** xsnps, int nrows, Indiv ** indivmarkers, int numindivs,
mean = xmean[col] / xfancy[col];
for (k = 0; k < 3; ++k)
- {
- y = ((double) k) - mean;
- y *= xfancy[col];
- gtable[col][k] = y / sqrt (2.0);
- }
+ {
+ y = ((double) k) - mean;
+ y *= xfancy[col];
+ gtable[col][k] = y / sqrt (2.0);
+ }
gtable[col][3] = 0;
t = MIN(n0, n1);
if (t == 0)
- cupt->ignore = YES; // side-effect
+ cupt->ignore = YES; // side-effect
}
free (cc);
@@ -184,15 +184,15 @@ kjg_geno_get_normalized_row (const size_t snp_index, double *y)
const uint8_t* u = UL[p]; // unpacked data
while (j < jf)
- {
- size_t o = j % 4; // offset in packed data
- size_t t = u[o]; // unpacked data
- y[i] = norm_lookup[t]; // normalized data
-
- if (++i == xnrows) // move onto next entry
- return; // break if we are done with SNP
- j = xxindex[i]; // perform the lookup
- }
+ {
+ size_t o = j % 4; // offset in packed data
+ size_t t = u[o]; // unpacked data
+ y[i] = norm_lookup[t]; // normalized data
+
+ if (++i == xnrows) // move onto next entry
+ return; // break if we are done with SNP
+ j = xxindex[i]; // perform the lookup
+ }
}
}
diff --git a/src/gval.h b/src/gval.h
deleted file mode 100644
index 75561ec..0000000
--- a/src/gval.h
+++ /dev/null
@@ -1,13 +0,0 @@
-void setgval (SNP ** xsnps, int nrows, Indiv ** indivmarkers, int numindivs,
- int *xindex, int *xtypes, int ncols);
-void unsetgval ();
-int getgval (int row, int col, double *val);
-int getggval (int indindx, int col, double *val);
-
-void set_ind_mask ();
-
-size_t get_nrows ();
-size_t get_ncols ();
-
-void kjg_geno_get_normalized_row (const size_t snp_index, double* y);
-size_t kjg_geno_get_normalized_rows (const size_t i, const size_t r, double* Y);
diff --git a/src/h2d.c b/src/h2d.c
index 7b20b27..fe21775 100644
--- a/src/h2d.c
+++ b/src/h2d.c
@@ -6,83 +6,95 @@
#include <nicklib.h>
#include <admutils.h>
-extern int verbose ;
+extern int verbose;
-int mkindh2d(Indiv **indivmarkers, Indiv ***pindm2, int numindivs)
+int
+mkindh2d (Indiv **indivmarkers, Indiv ***pindm2, int numindivs)
{
- char ss[50] ;
- Indiv *indx, **indm2, *indp ;
- int n, len, k ;
- int numind2 ;
+ char ss[50];
+ Indiv *indx, **indm2, *indp;
+ int n, len, k;
+ int numind2;
- numind2 = numindivs/2 ;
- ZALLOC(*pindm2, numind2, Indiv *) ;
- indm2 = *pindm2 ;
- n = 0 ;
- for (k=0; k<numindivs; k++) {
- indx = indivmarkers[k] ;
- strcpy(ss, indx -> ID) ;
- len = strlen(ss) ;
- if (ss[len-1] != 'A') continue ;
- ss[len-2] = CNULL ;
- ZALLOC(indm2[n], 1, Indiv) ;
- indp = indm2[n] ;
- *indp = *indx ;
- strcpy(indp->ID, ss) ;
- ++n ;
- }
- if (n != numind2) fatalx("(mkindh2d) bug\n") ;
- return n ;
-}
+ numind2 = numindivs / 2;
+ ZALLOC(*pindm2, numind2, Indiv *);
+ indm2 = *pindm2;
+ n = 0;
+ for (k = 0; k < numindivs; k++)
+ {
+ indx = indivmarkers[k];
+ strcpy (ss, indx->ID);
+ len = strlen (ss);
+ if (ss[len - 1] != 'A')
+ continue;
+ ss[len - 2] = CNULL;
+ ZALLOC(indm2[n], 1, Indiv);
+ indp = indm2[n];
+ *indp = *indx;
+ strcpy (indp->ID, ss);
+ ++n;
+ }
+ if (n != numind2)
+ fatalx ("(mkindh2d) bug\n");
+ return n;
+}
-void
-remaph2d(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2, int numindivs, int numind2)
+void
+remaph2d (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, Indiv **indm2,
+ int numindivs, int numind2)
{
- int *g1, *g2 ;
- int *x1, *x2 ;
- int *tind, tt, t, i, j, k, j1, j2 ;
- Indiv *indx ;
- SNP *cupt ;
- char s1[50], s2[50] ;
+ int *g1, *g2;
+ int *x1, *x2;
+ int *tind, tt, t, i, j, k, j1, j2;
+ Indiv *indx;
+ SNP *cupt;
+ char s1[50], s2[50];
- ZALLOC(g2, numind2, int) ;
- ZALLOC(g1, numindivs, int) ;
- ZALLOC(x1, numindivs, int) ;
- ZALLOC(x2, numindivs, int) ;
+ ZALLOC(g2, numind2, int);
+ ZALLOC(g1, numindivs, int);
+ ZALLOC(x1, numindivs, int);
+ ZALLOC(x2, numindivs, int);
- for (k=0; k<numind2; ++k) {
- indx = indm2[k] ;
- sprintf(s1, "%s:A", indx -> ID) ;
- sprintf(s2, "%s:B", indx -> ID) ;
- t = x1[k] = indindex(indivmarkers, numindivs, s1) ;
- if (t<0) {
- sprintf(s1, "%s_A", indx -> ID) ;
- sprintf(s2, "%s_B", indx -> ID) ;
- t = x1[k] = indindex(indivmarkers, numindivs, s1) ;
- }
- if (t<0) fatalx("bad newindiv: %s\n", indx -> ID) ;
- t = x2[k] = indindex(indivmarkers, numindivs, s2) ;
- if (t<0) fatalx("bad newindiv: %s\n", indx -> ID) ;
- }
+ for (k = 0; k < numind2; ++k)
+ {
+ indx = indm2[k];
+ sprintf (s1, "%s:A", indx->ID);
+ sprintf (s2, "%s:B", indx->ID);
+ t = x1[k] = indindex (indivmarkers, numindivs, s1);
+ if (t < 0)
+ {
+ sprintf (s1, "%s_A", indx->ID);
+ sprintf (s2, "%s_B", indx->ID);
+ t = x1[k] = indindex (indivmarkers, numindivs, s1);
+ }
+ if (t < 0)
+ fatalx ("bad newindiv: %s\n", indx->ID);
+ t = x2[k] = indindex (indivmarkers, numindivs, s2);
+ if (t < 0)
+ fatalx ("bad newindiv: %s\n", indx->ID);
+ }
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
- for (j=0; j<numind2; ++j) {
- t = x1[j] ;
- g1[j] = getgtypes(cupt, t) ;
- t = x2[j] ;
- g2[j] = getgtypes(cupt, t) ;
- tt = -1 ;
- if ((g1[j]>=0) && (g2[j] >=0)) tt = g1[j] + g2[j] ;
- putgtypes(cupt, j, tt) ;
- }
- }
+ for (j = 0; j < numind2; ++j)
+ {
+ t = x1[j];
+ g1[j] = getgtypes (cupt, t);
+ t = x2[j];
+ g2[j] = getgtypes (cupt, t);
+ tt = -1;
+ if ((g1[j] >= 0) && (g2[j] >= 0))
+ tt = g1[j] + g2[j];
+ putgtypes (cupt, j, tt);
+ }
+ }
- free(g1) ;
- free(g2) ;
- free(x1) ;
- free(x2) ;
+ free (g1);
+ free (g2);
+ free (x1);
+ free (x2);
}
diff --git a/src/ksrc/LICENSE.txt b/src/ksrc/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/src/ksrc/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/src/ksrc/kjg_fpca.c b/src/ksrc/kjg_fpca.c
index 2d1a045..27f24fe 100644
--- a/src/ksrc/kjg_fpca.c
+++ b/src/ksrc/kjg_fpca.c
@@ -15,7 +15,7 @@
#include "kjg_fpca.h"
#include "kjg_gsl.h"
-#include "admutils.h"
+#include "admutils.h"
#include "gval.h"
size_t KJG_FPCA_ROWS = 256;
@@ -49,8 +49,8 @@ kjg_fpca (size_t K, size_t L, size_t I, double *eval, double *evec)
// do the multiplication
kjg_fpca_XTXA (G1, &Qi.matrix, G2);
- // orthonormalize (Gram-Schmidt equivalent)
- kjg_gsl_matrix_QR (G2);
+ // scale to prevent G2 from blowing up
+ gsl_matrix_scale (G2, 1.0 / m);
Gswap = G2;
G2 = G1;
@@ -60,15 +60,15 @@ kjg_fpca (size_t K, size_t L, size_t I, double *eval, double *evec)
gsl_matrix_view Qi = gsl_matrix_submatrix (Q, 0, I * L, m, L);
kjg_fpca_XA (G1, &Qi.matrix);
- {
- gsl_matrix *V = gsl_matrix_alloc (Q->size2, Q->size2);
- gsl_vector *S = gsl_vector_alloc (Q->size2);
+ {
+ gsl_matrix *V = gsl_matrix_alloc (Q->size2, Q->size2);
+ gsl_vector *S = gsl_vector_alloc (Q->size2);
- kjg_gsl_SVD (Q, V, S);
+ kjg_gsl_SVD (Q, V, S);
- gsl_matrix_free (V);
- gsl_vector_free (S);
- }
+ gsl_matrix_free (V);
+ gsl_vector_free (S);
+ }
// kjg_gsl_matrix_QR(Q); // QR decomposition is less accurate than SVD
@@ -107,7 +107,7 @@ kjg_fpca_XTXA (const gsl_matrix * A1, gsl_matrix * B, gsl_matrix * A2)
size_t n = get_nrows ();
size_t i, r; // row index
- double *Y = malloc (sizeof (double) * n * KJG_FPCA_ROWS); // normalized
+ double *Y = malloc (sizeof(double) * n * KJG_FPCA_ROWS); // normalized
gsl_matrix_view Bi, Xi;
@@ -119,9 +119,9 @@ kjg_fpca_XTXA (const gsl_matrix * A1, gsl_matrix * B, gsl_matrix * A2)
Xi = gsl_matrix_view_array (Y, r, n);
Bi = gsl_matrix_submatrix (B, i, 0, r, B->size2);
gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1, &Xi.matrix, A1, 0,
- &Bi.matrix);
- gsl_blas_dgemm (CblasTrans, CblasNoTrans, 1, &Xi.matrix, &Bi.matrix,
- 1, A2);
+ &Bi.matrix);
+ gsl_blas_dgemm (CblasTrans, CblasNoTrans, 1, &Xi.matrix, &Bi.matrix, 1,
+ A2);
}
free (Y);
@@ -134,7 +134,7 @@ kjg_fpca_XA (const gsl_matrix * A, gsl_matrix * B)
size_t m = get_ncols ();
size_t i, r;
- double *Y = malloc (sizeof (double) * n * KJG_FPCA_ROWS);
+ double *Y = malloc (sizeof(double) * n * KJG_FPCA_ROWS);
gsl_matrix_view Hmat, Xmat;
@@ -146,7 +146,7 @@ kjg_fpca_XA (const gsl_matrix * A, gsl_matrix * B)
Xmat = gsl_matrix_view_array (Y, r, n);
Hmat = gsl_matrix_submatrix (B, i, 0, r, B->size2);
gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1, &Xmat.matrix, A, 0,
- &Hmat.matrix);
+ &Hmat.matrix);
}
free (Y);
@@ -159,7 +159,7 @@ kjg_fpca_XTB (const gsl_matrix * B, gsl_matrix * A)
size_t m = get_ncols ();
size_t i, r;
- double *Y = malloc (sizeof (double) * n * KJG_FPCA_ROWS);
+ double *Y = malloc (sizeof(double) * n * KJG_FPCA_ROWS);
gsl_matrix_view Xmat;
gsl_matrix_set_zero (A);
@@ -169,9 +169,9 @@ kjg_fpca_XTB (const gsl_matrix * B, gsl_matrix * A)
r = kjg_geno_get_normalized_rows (i, KJG_FPCA_ROWS, Y);
Xmat = gsl_matrix_view_array (Y, r, n);
gsl_matrix_const_view Hmat = gsl_matrix_const_submatrix (B, i, 0, r,
- B->size2);
+ B->size2);
gsl_blas_dgemm (CblasTrans, CblasNoTrans, 1, &Xmat.matrix, &Hmat.matrix,
- 1, A);
+ 1, A);
}
free (Y);
diff --git a/src/ksrc/kjg_gsl.c b/src/ksrc/kjg_gsl.c
index 97c0808..4a930a0 100644
--- a/src/ksrc/kjg_gsl.c
+++ b/src/ksrc/kjg_gsl.c
@@ -18,10 +18,10 @@ kjg_gsl_matrix_fprintf (FILE * stream, gsl_matrix * m, const char *template)
{
fprintf (stream, template, gsl_matrix_get (m, i, 0));
for (j = 1; j < m->size2; j++)
- {
- fprintf (stream, "\t");
- fprintf (stream, template, gsl_matrix_get (m, i, j));
- }
+ {
+ fprintf (stream, "\t");
+ fprintf (stream, template, gsl_matrix_get (m, i, j));
+ }
fprintf (stream, "\n");
}
}
@@ -34,17 +34,16 @@ kjg_gsl_matrix_fscanf (FILE * stream, gsl_matrix * m)
for (i = 0; i < m->size1; i++)
{
for (j = 0; j < m->size2; j++)
- {
- fscanf (stream, "%lg", &x);
- gsl_matrix_set (m, i, j, x);
- }
+ {
+ fscanf (stream, "%lg", &x);
+ gsl_matrix_set (m, i, j, x);
+ }
}
}
void
-kjg_gsl_evec_fprintf (FILE * stream,
- gsl_vector * eval,
- gsl_matrix * evec, const char *template)
+kjg_gsl_evec_fprintf (FILE * stream, gsl_vector * eval, gsl_matrix * evec,
+ const char *template)
{
size_t i, j;
fprintf (stream, "#");
@@ -74,19 +73,19 @@ kjg_gsl_evec_fscanf (FILE * stream, gsl_vector * eval, gsl_matrix * evec)
{
r = fscanf (stream, "%lg", &x);
if (r != 1)
- return (r);
+ return (r);
gsl_vector_set (eval, i, x);
}
for (i = 0; i < evec->size1; i++)
{
for (j = 0; j < evec->size2; j++)
- {
- r = fscanf (stream, "%lg", &x);
- if (r != 1)
- return (r);
- gsl_matrix_set (evec, i, j, x);
- }
+ {
+ r = fscanf (stream, "%lg", &x);
+ if (r != 1)
+ return (r);
+ gsl_matrix_set (evec, i, j, x);
+ }
}
return (0);
@@ -97,11 +96,11 @@ kjg_gsl_rng_init ()
{
const gsl_rng_type *T;
gsl_rng *r;
- extern long seed ;
+ extern long seed;
gsl_rng_env_setup ();
- gsl_rng_default_seed = seed ;
+ gsl_rng_default_seed = seed;
T = gsl_rng_default;
r = gsl_rng_alloc (T);
@@ -124,21 +123,21 @@ double
kjg_gsl_dlange (const char norm, const gsl_matrix * m)
{
return (LAPACKE_dlange (LAPACK_ROW_MAJOR, norm, m->size1, m->size2, m->data,
- m->tda));
+ m->tda));
}
int
kjg_gsl_dgeqrf (gsl_matrix * m, gsl_vector * tau)
{
- return (LAPACKE_dgeqrf (LAPACK_ROW_MAJOR, m->size1, m->size2, m->data,
- m->tda, tau->data));
+ return (LAPACKE_dgeqrf (LAPACK_ROW_MAJOR, m->size1, m->size2, m->data, m->tda,
+ tau->data));
}
int
kjg_gsl_dorgqr (gsl_matrix * m, gsl_vector * tau)
{
return (LAPACKE_dorgqr (LAPACK_ROW_MAJOR, m->size2, m->size2, m->size2,
- m->data, m->tda, tau->data));
+ m->data, m->tda, tau->data));
}
void
@@ -175,13 +174,13 @@ kjg_gsl_ran_ugaussian_matrix (const gsl_rng * r, gsl_matrix * m)
data = gsl_matrix_ptr (m, i, 0);
for (j = 0; j < m->size2 - 1; j += 2)
- {
- kjg_gsl_ran_ugaussian_pair (r, data);
- data += 2;
- }
+ {
+ kjg_gsl_ran_ugaussian_pair (r, data);
+ data += 2;
+ }
if (m->size2 % 2)
- *data = gsl_rng_uniform_pos (r);
+ *data = gsl_rng_uniform_pos (r);
}
}
@@ -198,12 +197,12 @@ int
kjg_gsl_SVD (gsl_matrix * M, gsl_matrix * V, gsl_vector * S)
{
size_t big_enough = M->size1 + V->size2;
- double *superb = malloc (big_enough * sizeof (double));
+ double *superb = malloc (big_enough * sizeof(double));
double *U;
- int info = LAPACKE_dgesvd (LAPACK_ROW_MAJOR, // row major
- 'O', 'S', M->size1, M->size2, M->data, M->tda,
- S->data, U,
- big_enough, V->data, V->tda, superb);
+ int info = LAPACKE_dgesvd (
+ LAPACK_ROW_MAJOR, // row major
+ 'O', 'S', M->size1, M->size2, M->data, M->tda, S->data, U, big_enough,
+ V->data, V->tda, superb);
free (superb);
return (info);
}
diff --git a/src/mcio.c b/src/mcio.c
index d36703b..94b9b27 100644
--- a/src/mcio.c
+++ b/src/mcio.c
@@ -7,4921 +7,5660 @@
/*! \file mcio.c
*
* \brief Input/Output Library
-*/
-
-
+ */
/* global data */
extern int numchrom;
-int usecm = NO ; //!< genetic distances are in cMorgans
-int plinkinputmode = NO ;
-static int snprawtab = NO ;
-static int debug = NO ;
-extern char *trashdir ;
-extern int qtmode ; //!< user parameter (phenotype is quantitative)
-extern int verbose ; //!< user parameter (print additional output to stdout)
-extern int familynames ; //!< user parameter (prepend PLINK family names with colon to individual names)
-extern double lp1, lp2 ;
-extern double a1, b1 ;
-
-extern int packmode ; //!< flag - input {is not,is} in packed mode
-extern char *packgenos ; //!< packed genotype data (packit.h)
-extern char *packepath ;
+int usecm = NO; //!< genetic distances are in cMorgans
+int plinkinputmode = NO;
+static int snprawtab = NO;
+static int debug = NO;
+extern char *trashdir;
+extern int qtmode; //!< user parameter (phenotype is quantitative)
+extern int verbose; //!< user parameter (print additional output to stdout)
+extern int familynames; //!< user parameter (prepend PLINK family names with colon to individual names)
+extern double lp1, lp2;
+extern double a1, b1;
+
+extern int packmode; //!< flag - input {is not,is} in packed mode
+extern char *packgenos; //!< packed genotype data (packit.h)
+extern char *packepath;
extern long packlen; //!< allocated size of packgenos data space
-extern long rlen; //!< number of bytes in packgenos space that each SNP's data occupies
-extern int malexhet ; //!< user parameter (retain het genotype data on male X chromosome)
-extern int hashcheck ; //!< user parameter (check input file hashes against input data)
-extern int outputall ;
-extern int sevencolumnped ;
-static int dofreeped = YES ;
-
-int tempnum = 0 ;
-int tempfake = 0 ;
-
-static int *snpord = NULL ; //!< snpord[i] == j if and only if snpm[j] is ith SNP in input file
-static int numsnpord = 0 ; //!< current size of array snpord
-static int *snporda[3] ; //!< Copies of snpord for various data sets (used by mergeit)
-static int numsnporda[3] ; //!< Number of elements of snporda in use
-
-static int badpedignore = NO ; //!< flag - ignore bad allele symbols in PED file
-
-static int maxgenolinelength = -1 ;
-static int tersemode = NO ;
-int checksizemode = YES ;
-int pedignore = YES ;
-enum outputmodetype outputmode = PACKEDANCESTRYMAP ;
-static double maxgpos[MAXCH] ;
-static int chrmode = NO ;
-static int chimpmode = NO ;
-static int pordercheck = YES ;
-static int snpordered ;
+extern long rlen; //!< number of bytes in packgenos space that each SNP's data occupies
+extern int malexhet; //!< user parameter (retain het genotype data on male X chromosome)
+extern int hashcheck; //!< user parameter (check input file hashes against input data)
+extern int outputall;
+extern int sevencolumnped;
+static int dofreeped = YES;
+
+int tempnum = 0;
+int tempfake = 0;
+
+static int *snpord = NULL; //!< snpord[i] == j if and only if snpm[j] is ith SNP in input file
+static int numsnpord = 0; //!< current size of array snpord
+static int *snporda[3]; //!< Copies of snpord for various data sets (used by mergeit)
+static int numsnporda[3]; //!< Number of elements of snporda in use
+
+static int badpedignore = NO; //!< flag - ignore bad allele symbols in PED file
+
+static int maxgenolinelength = -1;
+static int tersemode = NO;
+int checksizemode = YES;
+int pedignore = YES;
+enum outputmodetype outputmode = PACKEDANCESTRYMAP;
+static double maxgpos[MAXCH];
+static int chrmode = NO;
+static int chimpmode = NO;
+static int pordercheck = YES;
+static int snpordered;
// fails if packed and out of order
-
-SNPDATA *tsdpt ;
+SNPDATA *tsdpt;
/* local function prototypes */
-int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) ;
+int
+getbedgenos (char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs, int nignore);
-void freeped() ;
+void
+freeped ();
-static char x2base(int x) ;
-static void gtox(int g, char *cvals, int *p1, int *p2) ;
+static char
+x2base (int x);
+static void
+gtox (int g, char *cvals, int *p1, int *p2);
-int ancval(int x) ;
-static int setskipit(char *sx) ; // ignore lines in snp, map files
-int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash) ;
+int
+ancval (int x);
+static int
+setskipit (char *sx); // ignore lines in snp, map files
+int
+calcishash (SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash,
+ int *pshash);
/* ---------------------------------------------------------------------------------------------------- */
-void clearsnpord()
+void
+clearsnpord ()
{
- free(snpord) ;
- snpord = NULL ;
- numsnpord = 0 ;
+ free (snpord);
+ snpord = NULL;
+ numsnpord = 0;
}
-int getsnps(char *snpfname, SNP ***snpmarkpt, double spacing,
- char *badsnpname, int *numignore, int numrisks) {
+int
+getsnps (char *snpfname, SNP ***snpmarkpt, double spacing, char *badsnpname,
+ int *numignore, int numrisks)
+{
// returns number of SNPS
// numrisks
/* read file of real SNPS store in temporary structure */
- SNPDATA **snpraw, *sdpt ;
- static SNP **snpmarkers ;
- SNP *cupt ;
- int **snppos ;
- int nreal, nfake, numsnps = 0, i, t, j ;
- int *snpindx ;
- double xspace ;
- int failx = 0 ;
-
- if (snpfname == NULL) fatalx("(getsnps) null snpname") ;
- xspace = spacing ;
- nreal = getsizex(snpfname) ;
- if (nreal <= 0) fatalx("no snps found: snpfname: %s\n", snpfname) ;
- ZALLOC(snpraw, nreal, SNPDATA *) ;
-
- if (snpord == NULL) {
- ZALLOC(snpord, nreal, int) ;
- ivclear(snpord, -1, nreal) ;
- numsnpord = nreal ;
- }
- for (i=0; i<nreal ; i++) {
- ZALLOC(snpraw[i], 1, SNPDATA) ;
- cclear(snpraw[i] -> cchrom, CNULL, 7) ;
- snpraw[i] -> inputrow = -1 ;
- snpraw[i] -> alleles[0] = '1' ;
- snpraw[i] -> alleles[1] = '2' ;
- }
- nreal = readsnpdata(snpraw, snpfname) ;
- dobadsnps(snpraw, nreal, badsnpname) ;
-
- ZALLOC(snppos, nreal, int *) ;
- for (i=0; i<nreal; i++) {
- ZALLOC(snppos[i], 3, int) ;
- }
-
- for (i=0; i<nreal ; i++) {
- sdpt = snpraw[i] ;
- snppos[i][0] = sdpt -> chrom ;
- if ((sdpt->ignore) && (plinkinputmode)) snppos[i][0] = 99 ;
- t = snppos[i][1] = nnint((sdpt -> gpos)*GDISMUL) ;
- snppos[i][2] = nnint(sdpt -> ppos) ;
- // sdpt -> gpos = ((double) t)/ GDISMUL ;
- }
-
-/**
- for (i=nreal-10; i<nreal; i++) {
+ SNPDATA **snpraw, *sdpt;
+ static SNP **snpmarkers;
+ SNP *cupt;
+ int **snppos;
+ int nreal, nfake, numsnps = 0, i, t, j;
+ int *snpindx;
+ double xspace;
+ int failx = 0;
+
+ if (snpfname == NULL)
+ fatalx ("(getsnps) null snpname");
+ xspace = spacing;
+ nreal = getsizex (snpfname);
+ if (nreal <= 0)
+ fatalx ("no snps found: snpfname: %s\n", snpfname);
+ ZALLOC(snpraw, nreal, SNPDATA *);
+
+ if (snpord == NULL)
+ {
+ ZALLOC(snpord, nreal, int);
+ ivclear (snpord, -1, nreal);
+ numsnpord = nreal;
+ }
+ for (i = 0; i < nreal; i++)
+ {
+ ZALLOC(snpraw[i], 1, SNPDATA);
+ cclear (snpraw[i]->cchrom, CNULL, 7);
+ snpraw[i]->inputrow = -1;
+ snpraw[i]->alleles[0] = '1';
+ snpraw[i]->alleles[1] = '2';
+ }
+ nreal = readsnpdata (snpraw, snpfname);
+ dobadsnps (snpraw, nreal, badsnpname);
+
+ ZALLOC(snppos, nreal, int *);
+ for (i = 0; i < nreal; i++)
+ {
+ ZALLOC(snppos[i], 3, int);
+ }
+
+ for (i = 0; i < nreal; i++)
+ {
+ sdpt = snpraw[i];
+ snppos[i][0] = sdpt->chrom;
+ if ((sdpt->ignore) && (plinkinputmode))
+ snppos[i][0] = 99;
+ t = snppos[i][1] = nnint ((sdpt->gpos) * GDISMUL);
+ snppos[i][2] = nnint (sdpt->ppos);
+ // sdpt -> gpos = ((double) t)/ GDISMUL ;
+ }
+
+ /**
+ for (i=nreal-10; i<nreal; i++) {
printf("zzyy: %d ", i) ; printimat(snppos[i], 1, 3) ;
- }
-*/
+ }
+ */
- ZALLOC(snpindx, nreal, int) ;
- ipsortit(snppos, snpindx, nreal, 3) ;
+ ZALLOC(snpindx, nreal, int);
+ ipsortit (snppos, snpindx, nreal, 3);
snpordered = YES;
- for (i=0; i<nreal; ++i) {
- j = snpindx[i] ;
- if (j != i) {
- snpordered = NO ;
- ++failx ;
- if (failx < 10) {
- printf("snp order check fail (gdis order != physdis order): %s (processing continues)", snpfname) ; printimat(snppos[j], 1, 3) ;
+ for (i = 0; i < nreal; ++i)
+ {
+ j = snpindx[i];
+ if (j != i)
+ {
+ snpordered = NO;
+ ++failx;
+ if (failx < 10)
+ {
+ printf (
+ "snp order check fail (gdis order != physdis order): %s (processing continues)",
+ snpfname);
+ printimat (snppos[j], 1, 3);
+ }
+ }
}
- }
- }
-/**
- for (i=nreal-10; i<nreal; i++) {
+ /**
+ for (i=nreal-10; i<nreal; i++) {
printf("zzyy2: %d ", i) ; printimat(snppos[i], 1, 3) ;
- }
-*/
-
- if ((usecm) && (xspace>0.5)) {
- printf("*** warning fake spacing given in cM\n") ;
- xspace /= 100.0 ;
- }
-
+ }
+ */
+
+ if ((usecm) && (xspace > 0.5))
+ {
+ printf ("*** warning fake spacing given in cM\n");
+ xspace /= 100.0;
+ }
+
// get number of fakes
- nfake = numfakes(snpraw, snpindx, nreal, xspace) ;
- numsnps = nreal + nfake ;
-
- tempnum = numsnps ;
- tempfake = nfake ;
+ nfake = numfakes (snpraw, snpindx, nreal, xspace);
+ numsnps = nreal + nfake;
+
+ tempnum = numsnps;
+ tempfake = nfake;
// allocate storage
- ZALLOC(snpmarkers, numsnps, SNP *) ;
- for (i=0; i<numsnps; i++) {
- ZALLOC(snpmarkers[i], 1, SNP) ;
- cupt = snpmarkers[i] ;
- clearsnp(cupt) ;
- ZALLOC(cupt -> modelscores, numrisks, double) ;
- ZALLOC(cupt -> totmodelscores, numrisks, double) ;
- }
- tsdpt = snpraw[0] ;
- *snpmarkpt = snpmarkers ;
- numsnps = loadsnps(snpmarkers, snpraw, snpindx, nreal, xspace, numignore) ;
-
-/**
- for (i=numsnps-10; i<numsnps; i++) {
+ ZALLOC(snpmarkers, numsnps, SNP *);
+ for (i = 0; i < numsnps; i++)
+ {
+ ZALLOC(snpmarkers[i], 1, SNP);
+ cupt = snpmarkers[i];
+ clearsnp (cupt);
+ ZALLOC(cupt -> modelscores, numrisks, double);
+ ZALLOC(cupt -> totmodelscores, numrisks, double);
+ }
+ tsdpt = snpraw[0];
+ *snpmarkpt = snpmarkers;
+ numsnps = loadsnps (snpmarkers, snpraw, snpindx, nreal, xspace, numignore);
+
+ /**
+ for (i=numsnps-10; i<numsnps; i++) {
cupt = snpmarkers[i] ;
printf("zzyy3: %d %d %12.0f\n", i, cupt -> chrom, cupt -> physpos) ;
- }
-*/
-
-
-
+ }
+ */
// and free up temporary storage
- for (i=0; i<nreal ; i++) {
- free(snpraw[i]) ;
- free(snppos[i]) ;
- }
- free(snpraw) ;
- free(snppos) ;
- free(snpindx);
+ for (i = 0; i < nreal; i++)
+ {
+ free (snpraw[i]);
+ free (snppos[i]);
+ }
+ free (snpraw);
+ free (snppos);
+ free (snpindx);
/* printf("numsnps: %d\n", numsnps) ; */
/*
- if (snpord != NULL) {
- printimat(snpord, 1, MIN(100, numsnps)) ;
- }
- */
- cupt = snpmarkers[0] ;
- if (isnumword(cupt -> ID)) printf("*** warning: first snp %s is number. perhaps you are using .map format\n", cupt -> ID) ;
-
- return numsnps ;
+ if (snpord != NULL) {
+ printimat(snpord, 1, MIN(100, numsnps)) ;
+ }
+ */
+ cupt = snpmarkers[0];
+ if (isnumword (cupt->ID))
+ printf (
+ "*** warning: first snp %s is number. perhaps you are using .map format\n",
+ cupt->ID);
+
+ return numsnps;
}
-
-
-
/* ---------------------------------------------------------------------------------------------------- */
-int getsizex(char *fname) {
- char line[MAXSTR+1], c ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0 ;
- int skipit ;
- int len ;
-
- FILE *fff ;
- openit(fname, &fff, "r") ;
- line[MAXSTR] = '\0' ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ; // comment line
- if (skipit == NO) {
- ++num ;
- }
-
- // now flush the rest of the line if necessary.
- len = strlen(line) ;
- c = line[len-1] ;
- if (c != '\n') {
- while ((c = fgetc(fff)) != EOF) {
- if (c == '\n') break ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- fflush(stdout) ;
- return num ;
-}
+int
+getsizex (char *fname)
+{
+ char line[MAXSTR + 1], c;
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0;
+ int skipit;
+ int len;
+
+ FILE *fff;
+ openit (fname, &fff, "r");
+ line[MAXSTR] = '\0';
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = setskipit (sx); // comment line
+ if (skipit == NO)
+ {
+ ++num;
+ }
+ // now flush the rest of the line if necessary.
+ len = strlen (line);
+ c = line[len - 1];
+ if (c != '\n')
+ {
+ while ((c = fgetc (fff)) != EOF)
+ {
+ if (c == '\n')
+ break;
+ }
+ }
+ freeup (spt, nsplit);
+ continue;
+ }
+ fclose (fff);
+ fflush (stdout);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int ismapfile(char *fname) {
+int
+ismapfile (char *fname)
+{
// PLINK map file ?
// just look at file name (perhaps should look at format)
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
+ char *sx;
+ int len;
+ len = strlen (fname);
+ if (len < 4)
+ return NO;
+ sx = fname + len - 4;
- if (strcmp(sx, ".map") == 0) return YES ;
- if (strcmp(sx, ".bim") == 0) return YES ;
-
- if (len<7) return NO ;
- sx = fname+len-7 ;
- if (strcmp(sx, ".pedsnp") == 0) return YES ;
+ if (strcmp (sx, ".map") == 0)
+ return YES;
+ if (strcmp (sx, ".bim") == 0)
+ return YES;
- return NO ;
-
-}
+ if (len < 7)
+ return NO;
+ sx = fname + len - 7;
+ if (strcmp (sx, ".pedsnp") == 0)
+ return YES;
+ return NO;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int ispedfile(char *fname) {
+int
+ispedfile (char *fname)
+{
// PLINK ped file ?
// just look at file name (perhaps should look at format)
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
-
- if (strcmp(sx, ".ped") == 0) return YES ;
- if (strcmp(sx, ".fam") == 0) return YES ;
-
- if (len<7) return NO ;
- sx = fname+len-7 ;
- if (strcmp(sx, ".pedind") == 0) return YES ;
-
- return NO ;
+ char *sx;
+ int len;
+ len = strlen (fname);
+ if (len < 4)
+ return NO;
+ sx = fname + len - 4;
+
+ if (strcmp (sx, ".ped") == 0)
+ return YES;
+ if (strcmp (sx, ".fam") == 0)
+ return YES;
+
+ if (len < 7)
+ return NO;
+ sx = fname + len - 7;
+ if (strcmp (sx, ".pedind") == 0)
+ return YES;
+
+ return NO;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int isbedfile(char *fname) {
+int
+isbedfile (char *fname)
+{
// PLINK ped file ?
// just look at file name (perhaps should look at format)
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
+ char *sx;
+ int len;
+ len = strlen (fname);
+ if (len < 4)
+ return NO;
+ sx = fname + len - 4;
- if (strcmp(sx, ".bed") == 0) return YES ;
- return NO ;
+ if (strcmp (sx, ".bed") == 0)
+ return YES;
+ return NO;
}
/* ---------------------------------------------------------------------------------------------------- */
-int readsnpdata(SNPDATA **snpraw, char *fname) {
- char line[LONGSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- int skipit ;
- SNPDATA *sdpt ;
+int
+readsnpdata (SNPDATA **snpraw, char *fname)
+{
+ char line[LONGSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k;
+ int skipit;
+ SNPDATA *sdpt;
- double maxg = -9999.0 ;
+ double maxg = -9999.0;
- FILE *fff ;
- int chrom ;
- int nbad = 0 ;
+ FILE *fff;
+ int chrom;
+ int nbad = 0;
- plinkinputmode = NO ;
+ plinkinputmode = NO;
// if this is a PLINK file, call PLINK input routine
- if (ismapfile (fname)) {
- plinkinputmode = YES ;
- return readsnpmapdata(snpraw, fname) ;
- }
- usecm = NO ;
-
- vclear(maxgpos, -9999.0, MAXCH) ;
- openit(fname, &fff, "r") ;
- while (fgets(line, LONGSTR, fff) != NULL) {
-
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("(readsnpdata) bad line: %s\n",line) ;
- sdpt = snpraw[num] ;
- sdpt -> inputrow = num ;
-
- if (strlen(spt[0]) >= IDSIZE) fatalx("ID too long\n", spt[0]) ;
- strcpy(sdpt->ID, spt[0]) ;
-
- sdpt -> chrom = chrom = str2chrom(spt[1]) ;
- strncpy(sdpt -> cchrom, spt[1], 6) ;
-
- if ((chrom>=MAXCH) || (chrom <=0)) {
- if (nbad<10) printf("warning: bad chrom: %s", line) ;
- ++nbad ;
-
- sdpt -> chrom = MIN(chrom, BADCHROM) ;
- sdpt -> chrom = MAX(chrom, 0) ;
- sdpt -> ignore = YES ;
- }
-
- // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
- // any genetic position is greater than 100
-
- sdpt -> gpos = atof(spt[2]) ;
- if (sdpt->gpos > 100) {
- if (sdpt->gpos > 1.0e6)
- fatalx("absurd genetic distance:\n%s\n", line) ;
- if (!usecm) {
- printf("*** warning. genetic distances are in cM not Morgans\n") ;
- printf("%s\n",line) ;
- }
- usecm = YES ; // set flag to connvert to Morgans
- }
-
- maxgpos[chrom] = MAX(maxgpos[chrom], sdpt -> gpos) ;
- maxg = MAX(maxg, maxgpos[chrom]) ;
-
- setsdpos(sdpt, atoi(spt[3])) ;
- if (nsplit<8) {
- ivzero(sdpt->nn,4) ;
- if (nsplit==6) {
- sx = spt[4] ; sdpt -> alleles[0] = toupper(sx[0]) ;
- sx = spt[5] ; sdpt -> alleles[1] = toupper(sx[0]) ;
- }
- }
- else { // QUESTION: when does a SNP file have more than seven columns?
- for (k=0; k<4; k++) {
- sdpt->nn[k] = atoi(spt[4+k]) ;
- }
- if (nsplit==10) {
- sx = spt[8] ; sdpt -> alleles[0] = toupper(sx[0]) ;
- sx = spt[9] ; sdpt -> alleles[1] = toupper(sx[0]) ;
- }
- }
- ++num ;
+ if (ismapfile (fname))
+ {
+ plinkinputmode = YES;
+ return readsnpmapdata (snpraw, fname);
}
- freeup(spt, nsplit) ;
- continue ;
- } // elihw
+ usecm = NO;
+
+ vclear (maxgpos, -9999.0, MAXCH);
+ openit (fname, &fff, "r");
+ while (fgets (line, LONGSTR, fff) != NULL)
+ {
+
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = setskipit (sx);
+ if (skipit == NO)
+ {
+ if (nsplit < 4)
+ fatalx ("(readsnpdata) bad line: %s\n", line);
+ sdpt = snpraw[num];
+ sdpt->inputrow = num;
+
+ if (strlen (spt[0]) >= IDSIZE)
+ fatalx ("ID too long\n", spt[0]);
+ strcpy (sdpt->ID, spt[0]);
+
+ sdpt->chrom = chrom = str2chrom (spt[1]);
+ strncpy (sdpt->cchrom, spt[1], 6);
+
+ if ((chrom >= MAXCH) || (chrom <= 0))
+ {
+ if (nbad < 10)
+ printf ("warning: bad chrom: %s", line);
+ ++nbad;
+
+ sdpt->chrom = MIN(chrom, BADCHROM);
+ sdpt->chrom = MAX(chrom, 0);
+ sdpt->ignore = YES;
+ }
+
+ // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
+ // any genetic position is greater than 100
+
+ sdpt->gpos = atof (spt[2]);
+ if (sdpt->gpos > 100)
+ {
+ if (sdpt->gpos > 1.0e6)
+ fatalx ("absurd genetic distance:\n%s\n", line);
+ if (!usecm)
+ {
+ printf (
+ "*** warning. genetic distances are in cM not Morgans\n");
+ printf ("%s\n", line);
+ }
+ usecm = YES; // set flag to connvert to Morgans
+ }
+
+ maxgpos[chrom] = MAX(maxgpos[chrom], sdpt->gpos);
+ maxg = MAX(maxg, maxgpos[chrom]);
+
+ setsdpos (sdpt, atoi (spt[3]));
+ if (nsplit < 8)
+ {
+ ivzero (sdpt->nn, 4);
+ if (nsplit == 6)
+ {
+ sx = spt[4];
+ sdpt->alleles[0] = toupper(sx[0]);
+ sx = spt[5];
+ sdpt->alleles[1] = toupper(sx[0]);
+ }
+ }
+ else
+ { // QUESTION: when does a SNP file have more than seven columns?
+ for (k = 0; k < 4; k++)
+ {
+ sdpt->nn[k] = atoi (spt[4 + k]);
+ }
+ if (nsplit == 10)
+ {
+ sx = spt[8];
+ sdpt->alleles[0] = toupper(sx[0]);
+ sx = spt[9];
+ sdpt->alleles[1] = toupper(sx[0]);
+ }
+ }
+ ++num;
+ }
+ freeup (spt, nsplit);
+ continue;
+ } // elihw
// if all genetic positions are set to zero, set from physical position
- if (maxg<=0.00001) {
- printf("%s: genetic distance set from physical distance\n", fname) ;
- usecm = NO ;
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos = 1.0e-8 * snpraw[k] -> ppos ;
+ if (maxg <= 0.00001)
+ {
+ printf ("%s: genetic distance set from physical distance\n", fname);
+ usecm = NO;
+ for (k = 0; k < num; ++k)
+ {
+ snpraw[k]->gpos = 1.0e-8 * snpraw[k]->ppos;
+ }
}
- }
// convert to Morgans
- if (usecm) {
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos /= 100.0 ;
- }
- }
-
- fclose(fff) ;
- return num ;
-}
+ if (usecm)
+ {
+ for (k = 0; k < num; ++k)
+ {
+ snpraw[k]->gpos /= 100.0;
+ }
+ }
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int readsnpmapdata(SNPDATA **snpraw, char *fname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, t ;
- int skipit, len ;
- SNPDATA *sdpt ;
- int nbad = 0 ;
-
- FILE *fff ;
- int chrom ;
- double maxg = -9999.0 ;
-
- vclear(maxgpos, -9999.0, MAXCH) ;
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("(readsnpmapdata) bad line: %s\n",line) ;
- sdpt = snpraw[num] ;
- if (strlen(spt[1]) >= IDSIZE) fatalx("ID too long\n", spt[1]) ;
- strcpy(sdpt->ID, spt[1]) ;
-
- if (nsplit >=6 ) { // alleles in .map file are optional
- sx = spt[4] ; sdpt -> alleles[0] = sx[0] ;
- sx = spt[5] ; sdpt -> alleles[1] = sx[0] ;
- if (sdpt->alleles[0] == '0') sdpt -> alleles[0] = 'X' ; // unknown
- if (sdpt->alleles[1] == '0') sdpt -> alleles[1] = 'X' ;
- }
- else {
- cclear((unsigned char *) sdpt -> alleles, CNULL, 2) ;
- }
-
- sx = spt[0] ;
- sdpt -> chrom = chrom = str2chrom(sx) ;
- strncpy(sdpt -> cchrom, sx, 6) ;
-
- if ((chrom>=MAXCH) || (chrom <=0)) {
- if (nbad<10) printf("warning (mapfile): bad chrom: %s", line) ;
- ++nbad ;
-
- sdpt -> chrom = MIN(chrom, BADCHROM) ;
- sdpt -> chrom = MAX(chrom, 0) ;
- sdpt -> chrom = 99 ;
- strcpy(sdpt -> cchrom, "99") ;
- sdpt -> ignore = YES ;
- }
-
- // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
- // any genetic position is greater than 100
-
- sdpt -> gpos = atof(spt[2]) ;
- if (sdpt->gpos > 100) {
- if (sdpt->gpos > 1.0e6)
- fatalx("absurd genetic distance:\n%s\n", line) ;
- if (!usecm) {
- printf("*** warning. genetic distances are in cM not Morgans\n") ;
- printf("%s\n",line) ;
+int
+readsnpmapdata (SNPDATA **snpraw, char *fname)
+{
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k, t;
+ int skipit, len;
+ SNPDATA *sdpt;
+ int nbad = 0;
+
+ FILE *fff;
+ int chrom;
+ double maxg = -9999.0;
+
+ vclear (maxgpos, -9999.0, MAXCH);
+ openit (fname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = setskipit (sx);
+ if (skipit == NO)
+ {
+ if (nsplit < 4)
+ fatalx ("(readsnpmapdata) bad line: %s\n", line);
+ sdpt = snpraw[num];
+ if (strlen (spt[1]) >= IDSIZE)
+ fatalx ("ID too long\n", spt[1]);
+ strcpy (sdpt->ID, spt[1]);
+
+ if (nsplit >= 6)
+ { // alleles in .map file are optional
+ sx = spt[4];
+ sdpt->alleles[0] = sx[0];
+ sx = spt[5];
+ sdpt->alleles[1] = sx[0];
+ if (sdpt->alleles[0] == '0')
+ sdpt->alleles[0] = 'X'; // unknown
+ if (sdpt->alleles[1] == '0')
+ sdpt->alleles[1] = 'X';
+ }
+ else
+ {
+ cclear ((unsigned char *) sdpt->alleles, CNULL, 2);
+ }
+
+ sx = spt[0];
+ sdpt->chrom = chrom = str2chrom (sx);
+ strncpy (sdpt->cchrom, sx, 6);
+
+ if ((chrom >= MAXCH) || (chrom <= 0))
+ {
+ if (nbad < 10)
+ printf ("warning (mapfile): bad chrom: %s", line);
+ ++nbad;
+
+ sdpt->chrom = MIN(chrom, BADCHROM);
+ sdpt->chrom = MAX(chrom, 0);
+ sdpt->chrom = 99;
+ strcpy (sdpt->cchrom, "99");
+ sdpt->ignore = YES;
+ }
+
+ // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
+ // any genetic position is greater than 100
+
+ sdpt->gpos = atof (spt[2]);
+ if (sdpt->gpos > 100)
+ {
+ if (sdpt->gpos > 1.0e6)
+ fatalx ("absurd genetic distance:\n%s\n", line);
+ if (!usecm)
+ {
+ printf (
+ "*** warning. genetic distances are in cM not Morgans\n");
+ printf ("%s\n", line);
+ }
+ usecm = YES;
+ }
+ maxgpos[chrom] = MAX(maxgpos[chrom], sdpt->gpos);
+ maxg = MAX(maxg, maxgpos[chrom]);
+ sdpt->ppos = atof (spt[3]);
+ if (nsplit < 8)
+ {
+ ivzero (sdpt->nn, 4);
+ }
+ else
+ {
+ for (k = 0; k < 4; k++)
+ {
+ sdpt->nn[k] = atoi (spt[4 + k]);
+ }
+ }
+ sdpt->inputrow = num;
+// printf("zz %d %d %s %12.0f\n", num, sdpt -> chrom, sdpt -> ID, sdpt -> ppos) ;
+ ++num;
}
- usecm = YES ;
- }
- maxgpos[chrom] = MAX(maxgpos[chrom], sdpt -> gpos) ;
- maxg = MAX(maxg, maxgpos[chrom]) ;
- sdpt -> ppos = atof(spt[3]) ;
- if (nsplit<8) {
- ivzero(sdpt->nn,4) ;
- }
- else {
- for (k=0; k<4; k++) {
- sdpt->nn[k] = atoi(spt[4+k]) ;
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ if (maxg <= 0.00001)
+ {
+ printf ("genetic distance set from physical distance\n");
+ usecm = NO;
+ for (k = 0; k < num; ++k)
+ {
+ snpraw[k]->gpos = 1.0e-8 * snpraw[k]->ppos;
}
- }
- sdpt -> inputrow = num ;
-// printf("zz %d %d %s %12.0f\n", num, sdpt -> chrom, sdpt -> ID, sdpt -> ppos) ;
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
-
- if (maxg<=0.00001) {
- printf("genetic distance set from physical distance\n") ;
- usecm = NO ;
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos = 1.0e-8 * snpraw[k] -> ppos ;
- }
- }
-
- if (usecm) {
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos /= 100.0 ;
- }
- }
-
- if (snpord == NULL) {
- ZALLOC(snpord, num, int) ;
- ivclear(snpord, -1, num) ;
- numsnpord = num ;
- }
-
- fclose(fff) ;
- return num ;
-}
+ }
+ if (usecm)
+ {
+ for (k = 0; k < num; ++k)
+ {
+ snpraw[k]->gpos /= 100.0;
+ }
+ }
+
+ if (snpord == NULL)
+ {
+ ZALLOC(snpord, num, int);
+ ivclear (snpord, -1, num);
+ numsnpord = num;
+ }
+
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing) {
+int
+numfakes (SNPDATA **snpraw, int *snpindx, int nreal, double spacing)
+{
// it seems better for this internal routine
// to use the precomputed values
-
- int nignore, numsnps;
- int nfake = 0, i, k, indx ;
- int num=0;
- SNP *cupt ;
- SNPDATA *sdpt ;
- char *sname ;
- int *sp ;
- int xc = 0, chrom ;
- double fakedis, realdis ; // gpos for fake marker
- double yf, yr ;
- double physpos ;
-
- if (spacing <= 0.0) fakedis = 1.0e20 ;
- for (k=0; k< nreal ; k++) {
-
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
-
- chrom = sdpt -> chrom ;
- realdis = sdpt -> gpos ;
-
- if (chrom != xc) {
- fakedis = nextmesh(realdis, spacing) ;
- xc = chrom ;
- }
- while (fakedis<realdis) {
- fakedis += spacing ;
- ++nfake ;
+ int nignore, numsnps;
+ int nfake = 0, i, k, indx;
+ int num = 0;
+ SNP *cupt;
+ SNPDATA *sdpt;
+ char *sname;
+ int *sp;
+ int xc = 0, chrom;
+ double fakedis, realdis; // gpos for fake marker
+ double yf, yr;
+ double physpos;
+
+ if (spacing <= 0.0)
+ fakedis = 1.0e20;
+
+ for (k = 0; k < nreal; k++)
+ {
+
+ indx = snpindx[k];
+ sdpt = snpraw[indx];
+
+ chrom = sdpt->chrom;
+ realdis = sdpt->gpos;
+
+ if (chrom != xc)
+ {
+ fakedis = nextmesh (realdis, spacing);
+ xc = chrom;
+ }
+ while (fakedis < realdis)
+ {
+ fakedis += spacing;
+ ++nfake;
+ }
}
- }
// nfake is number of multiples of fakedis in chromosome
-
- return nfake ;
-}
-
+ return nfake;
+}
/* ---------------------------------------------------------------------------------------------------- */
-double nextmesh(double val, double spacing) {
- double y ;
-
- if (spacing==0.0) return 1.0e8 ;
- y = ceil(val/spacing)*spacing ;
- if (y<val) y += spacing ;
- return y ;
+double
+nextmesh (double val, double spacing)
+{
+ double y;
+
+ if (spacing == 0.0)
+ return 1.0e8;
+ y = ceil (val / spacing) * spacing;
+ if (y < val)
+ y += spacing;
+ return y;
}
-
/* ---------------------------------------------------------------------------------------------------- */
/*! \fn int loadsnps(SNP **snpm, SNPDATA **snpraw,
- int *snpindx, int nreal, double spacing, int *numignore)
- \brief Store raw SNP data in final array of type SNP *
- \param snpm Pointer to array of type SNP * in which to store data
- \param snpraw Pointer to array of type SNPDATA * in which preliminary data was stored
- \param snpindx On entry, kth element of snpindx is index of the kth SNP in snpraw (This is not
- the same as the value k itself if the SNPs were out of order in the file.)
- \param nreal Number of SNPs stored in snpraw
- \param spacing Maximum spacing between SNPs (not relevant to EIGENSOFT)
- \param numignore Return number of SNPs to ignore here
-*/
-
+ int *snpindx, int nreal, double spacing, int *numignore)
+ \brief Store raw SNP data in final array of type SNP *
+ \param snpm Pointer to array of type SNP * in which to store data
+ \param snpraw Pointer to array of type SNPDATA * in which preliminary data was stored
+ \param snpindx On entry, kth element of snpindx is index of the kth SNP in snpraw (This is not
+ the same as the value k itself if the SNPs were out of order in the file.)
+ \param nreal Number of SNPs stored in snpraw
+ \param spacing Maximum spacing between SNPs (not relevant to EIGENSOFT)
+ \param numignore Return number of SNPs to ignore here
+ */
-int loadsnps(SNP **snpm, SNPDATA **snpraw,
- int *snpindx, int nreal, double spacing, int *numignore) {
+int
+loadsnps (SNP **snpm, SNPDATA **snpraw, int *snpindx, int nreal, double spacing,
+ int *numignore)
+{
// snppos, snpindx could be recalculated but
// it seems better for this internal routine
// to use the precomputed values
// do NOT call externally
-
+
int nignore, numsnps;
- int nfake = 0, i, k, indx ;
- int num=0, tnum;
- SNP *cupt= NULL, *lastcupt = NULL, *tcupt ;
- SNPDATA *sdpt ;
- char *sname ;
- int *sp ;
- int xc = 0, chrom ;
- double fakedis, realdis, xrealdis ; // gpos for fake marker
- double yf, yr ;
- double physpos ;
- double xl, xr, xmid, al, ar, fraw ;
- double y ;
- int nn[2], n0, n1 ;
- int cnum, t ;
- int inputrow, chimpfudge, xchimpfudge ;
- int ischimp = NO ;
- char ss[6] ;
-
- if (spacing <= 0.0) fakedis = 1.0e20 ;
- strcpy(ss, "??") ;
-
- for (k=0; k< nreal ; k++) {
-
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
-
- chrom = sdpt -> chrom ;
+ int nfake = 0, i, k, indx;
+ int num = 0, tnum;
+ SNP *cupt = NULL, *lastcupt = NULL, *tcupt;
+ SNPDATA *sdpt;
+ char *sname;
+ int *sp;
+ int xc = 0, chrom;
+ double fakedis, realdis, xrealdis; // gpos for fake marker
+ double yf, yr;
+ double physpos;
+ double xl, xr, xmid, al, ar, fraw;
+ double y;
+ int nn[2], n0, n1;
+ int cnum, t;
+ int inputrow, chimpfudge, xchimpfudge;
+ int ischimp = NO;
+ char ss[6];
+
+ if (spacing <= 0.0)
+ fakedis = 1.0e20;
+ strcpy (ss, "??");
+
+ for (k = 0; k < nreal; k++)
+ {
+
+ indx = snpindx[k];
+ sdpt = snpraw[indx];
+
+ chrom = sdpt->chrom;
// defensive programming; should not be needed:
- if (sdpt -> cchrom[0] == CNULL) {
- sprintf(sdpt -> cchrom, "%d", chrom) ;
- }
- sname = sdpt -> ID ;
- realdis = sdpt -> gpos ;
- physpos = sdpt -> ppos ;
- inputrow = sdpt -> inputrow ;
- if (sdpt -> chimpfudge) ischimp = YES ;
-
-/**
- if (k>(nreal-10)) {
- printf("zzyy2b %d %d %12.0f %d\n", k, chrom, physpos, inputrow) ;
- }
-*/
-
- t = strcmp(ss, sdpt -> cchrom) ;
- if (t != 0) {
- fakedis = nextmesh(realdis, spacing) ;
- xc = chrom ;
- cnum = 0 ;
- strcpy(ss, sdpt -> cchrom) ;
- }
-
- yf = fakedis ;
- yr = realdis ;
-
- // insert fake SNPs so the distance between SNPs is no greater than spacing
- while (fakedis<realdis) {
-
- if (cnum==0) break ; // first SNP on chromosome
- if (sdpt -> ignore) break ;
-
- if (nfake>=tempfake) fatalx(" too many fake markers (bug) %d %d\n", num, nfake) ;
- if (num>=tempnum) fatalx(" too many markers (bug) %d %d\n", num, nfake) ;
-
- cupt = snpm[num] ;
- if (cupt == NULL) fatalx("bad loadsnps\n") ;
- sprintf(cupt -> ID, "fake-%d:%d", xc, nfake) ;
- cupt -> estgenpos = cupt -> genpos = fakedis ;
- tcupt = lastcupt ;
- for (;;) {
- xl = tcupt -> genpos ;
- if (xl < fakedis) break ;
- tnum = tcupt -> markernum ;
- --tnum ;
- if (tnum<0) fatalx("verybadbug\n") ;
- tcupt = snpm[tnum] ;
- if (tcupt -> chrom != chrom) fatalx("badbug\n") ;
- }
- al = tcupt -> physpos ;
- xr = realdis ; ;
- ar = physpos ;
- y= cupt -> physpos = interp(xl, xr, fakedis, al, ar) ;
- if (chrom == -199) {
- printf("zzinterp %12.6f %12.6f %12.6f %12.0f %12.0f %12.6f\n",
- xl, xr, fakedis, al, ar, y) ;
- }
- cupt -> markernum = num ;
- cupt -> isfake = YES ;
- cupt -> chrom = xc ;
- strncpy(cupt -> cchrom, ss, 6) ;
- fakedis += spacing ;
- ++num ;
- ++nfake ;
- }
-
- cupt = snpm[num] ;
- if (cupt == NULL) fatalx("bad loadsnps\n") ;
- strcpy(cupt -> ID, sname) ;
- sdpt -> cuptnum = num ;
- cupt -> estgenpos = cupt -> genpos = realdis ;
- cupt -> physpos = physpos ;
- cupt -> markernum = num ;
- cupt -> isfake = NO ;
- cupt -> ignore = sdpt -> ignore ;
- // if ((cupt -> ignore == NO) && (cupt -> isfake == NO))
- if ((cupt -> isfake == NO)) {
- lastcupt = cupt ;
- ++cnum ;
- }
- cupt -> isrfake = sdpt -> isrfake ;
- cupt -> chrom = xc ;
- strncpy(cupt -> cchrom, ss, 6) ;
- cupt -> tagnumber = inputrow ; // just used for pedfile
- if (inputrow >=0) {
- if (inputrow >= numsnpord) fatalx("snpord overflow\n") ;
- snpord[inputrow] = num ;
- }
-
- n0 = sdpt->nn[0] ;
- n1 = sdpt->nn[1] ;
- fraw = mknn(nn, n0, n1) ;
- copyiarr(nn, cupt->af_nn, 2) ;
- cupt -> aftrue = cupt -> af_freq = fraw ;
- cupt -> aa_aftrue = cupt -> aa_af_freq = fraw ;
-
- if (sdpt -> alleles != NULL) {
- cupt -> alleles[0] = sdpt -> alleles[0] ;
- cupt -> alleles[1] = sdpt -> alleles[1] ;
- }
- else {
- cupt -> alleles[0] = '1' ;
- cupt -> alleles[1] = '2' ;
- }
-
- n0 = sdpt->nn[2] ;
- n1 = sdpt->nn[3] ;
- fraw = mknn(nn, n0, n1) ;
- copyiarr(nn, cupt->cauc_nn, 2) ;
- cupt -> cftrue = cupt -> cauc_freq = fraw ;
- cupt -> aa_cftrue = cupt -> aa_cauc_freq = fraw ;
- ++num ;
- }
+ if (sdpt->cchrom[0] == CNULL)
+ {
+ sprintf (sdpt->cchrom, "%d", chrom);
+ }
+ sname = sdpt->ID;
+ realdis = sdpt->gpos;
+ physpos = sdpt->ppos;
+ inputrow = sdpt->inputrow;
+ if (sdpt->chimpfudge)
+ ischimp = YES;
+
+ /**
+ if (k>(nreal-10)) {
+ printf("zzyy2b %d %d %12.0f %d\n", k, chrom, physpos, inputrow) ;
+ }
+ */
+
+ t = strcmp (ss, sdpt->cchrom);
+ if (t != 0)
+ {
+ fakedis = nextmesh (realdis, spacing);
+ xc = chrom;
+ cnum = 0;
+ strcpy (ss, sdpt->cchrom);
+ }
+
+ yf = fakedis;
+ yr = realdis;
+
+ // insert fake SNPs so the distance between SNPs is no greater than spacing
+ while (fakedis < realdis)
+ {
+
+ if (cnum == 0)
+ break; // first SNP on chromosome
+ if (sdpt->ignore)
+ break;
+
+ if (nfake >= tempfake)
+ fatalx (" too many fake markers (bug) %d %d\n", num, nfake);
+ if (num >= tempnum)
+ fatalx (" too many markers (bug) %d %d\n", num, nfake);
+
+ cupt = snpm[num];
+ if (cupt == NULL)
+ fatalx ("bad loadsnps\n");
+ sprintf (cupt->ID, "fake-%d:%d", xc, nfake);
+ cupt->estgenpos = cupt->genpos = fakedis;
+ tcupt = lastcupt;
+ for (;;)
+ {
+ xl = tcupt->genpos;
+ if (xl < fakedis)
+ break;
+ tnum = tcupt->markernum;
+ --tnum;
+ if (tnum < 0)
+ fatalx ("verybadbug\n");
+ tcupt = snpm[tnum];
+ if (tcupt->chrom != chrom)
+ fatalx ("badbug\n");
+ }
+ al = tcupt->physpos;
+ xr = realdis;
+ ;
+ ar = physpos;
+ y = cupt->physpos = interp (xl, xr, fakedis, al, ar);
+ if (chrom == -199)
+ {
+ printf (
+ "zzinterp %12.6f %12.6f %12.6f %12.0f %12.0f %12.6f\n",
+ xl, xr, fakedis, al, ar, y);
+ }
+ cupt->markernum = num;
+ cupt->isfake = YES;
+ cupt->chrom = xc;
+ strncpy (cupt->cchrom, ss, 6);
+ fakedis += spacing;
+ ++num;
+ ++nfake;
+ }
+
+ cupt = snpm[num];
+ if (cupt == NULL)
+ fatalx ("bad loadsnps\n");
+ strcpy (cupt->ID, sname);
+ sdpt->cuptnum = num;
+ cupt->estgenpos = cupt->genpos = realdis;
+ cupt->physpos = physpos;
+ cupt->markernum = num;
+ cupt->isfake = NO;
+ cupt->ignore = sdpt->ignore;
+ // if ((cupt -> ignore == NO) && (cupt -> isfake == NO))
+ if ((cupt->isfake == NO))
+ {
+ lastcupt = cupt;
+ ++cnum;
+ }
+ cupt->isrfake = sdpt->isrfake;
+ cupt->chrom = xc;
+ strncpy (cupt->cchrom, ss, 6);
+ cupt->tagnumber = inputrow; // just used for pedfile
+ if (inputrow >= 0)
+ {
+ if (inputrow >= numsnpord)
+ fatalx ("snpord overflow\n");
+ snpord[inputrow] = num;
+ }
+
+ n0 = sdpt->nn[0];
+ n1 = sdpt->nn[1];
+ fraw = mknn (nn, n0, n1);
+ copyiarr (nn, cupt->af_nn, 2);
+ cupt->aftrue = cupt->af_freq = fraw;
+ cupt->aa_aftrue = cupt->aa_af_freq = fraw;
+
+ if (sdpt->alleles != NULL)
+ {
+ cupt->alleles[0] = sdpt->alleles[0];
+ cupt->alleles[1] = sdpt->alleles[1];
+ }
+ else
+ {
+ cupt->alleles[0] = '1';
+ cupt->alleles[1] = '2';
+ }
+
+ n0 = sdpt->nn[2];
+ n1 = sdpt->nn[3];
+ fraw = mknn (nn, n0, n1);
+ copyiarr (nn, cupt->cauc_nn, 2);
+ cupt->cftrue = cupt->cauc_freq = fraw;
+ cupt->aa_cftrue = cupt->aa_cauc_freq = fraw;
+ ++num;
+ }
// now make list of ignored snps used by loadgeno for check
- numsnps = num ;
- for (k=0; k< nreal ; k++) {
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
- if (sdpt->ignore == NO) continue ;
- inputrow = sdpt -> inputrow ;
- chrom = sdpt -> chrom ;
- sname = sdpt -> ID ;
- realdis = sdpt -> gpos ;
- physpos = sdpt -> ppos ;
- cupt = snpm[sdpt -> cuptnum] ;
- cupt -> tagnumber = inputrow ; // just used for pedfile
- /*
- strncpy(cupt -> ID, sname, IDSIZE-1) ;
- cupt -> genpos = realdis ;
- cupt -> physpos = physpos ;
- cupt -> markernum = num ;
- cupt -> isfake = NO ;
- cupt -> ignore = YES ;
- cupt -> chrom = chrom ;
- */
- ++num ;
- }
- nignore = 0 ;
- for (k=0; k<numsnps; ++k) {
- cupt = snpm[k] ;
- if (ischimp && (cupt -> chrom == 2)) cupt -> chimpfudge = YES ;
- if (cupt -> ignore) ++nignore ;
- }
- *numignore = nignore ;
- return numsnps ;
+ numsnps = num;
+ for (k = 0; k < nreal; k++)
+ {
+ indx = snpindx[k];
+ sdpt = snpraw[indx];
+ if (sdpt->ignore == NO)
+ continue;
+ inputrow = sdpt->inputrow;
+ chrom = sdpt->chrom;
+ sname = sdpt->ID;
+ realdis = sdpt->gpos;
+ physpos = sdpt->ppos;
+ cupt = snpm[sdpt->cuptnum];
+ cupt->tagnumber = inputrow; // just used for pedfile
+ /*
+ strncpy(cupt -> ID, sname, IDSIZE-1) ;
+ cupt -> genpos = realdis ;
+ cupt -> physpos = physpos ;
+ cupt -> markernum = num ;
+ cupt -> isfake = NO ;
+ cupt -> ignore = YES ;
+ cupt -> chrom = chrom ;
+ */
+ ++num;
+ }
+ nignore = 0;
+ for (k = 0; k < numsnps; ++k)
+ {
+ cupt = snpm[k];
+ if (ischimp && (cupt->chrom == 2))
+ cupt->chimpfudge = YES;
+ if (cupt->ignore)
+ ++nignore;
+ }
+ *numignore = nignore;
+ return numsnps;
}
/* ---------------------------------------------------------------------------------------------------- */
-double interp (double l, double r, double x, double al, double ar) {
+double
+interp (double l, double r, double x, double al, double ar)
+{
// linearly interp ;
- double y, y1, y2 ;
- y = (r-l) ;
- if (y==0.0) return 0.5*(al+ar) ;
- y1 = (r-x)/y ;
- y2 = (x-l)/y ;
- return y1*al +y2*ar ;
+ double y, y1, y2;
+ y = (r - l);
+ if (y == 0.0)
+ return 0.5 * (al + ar);
+ y1 = (r - x) / y;
+ y2 = (x - l) / y;
+ return y1 * al + y2 * ar;
}
/* ---------------------------------------------------------------------------------------------------- */
-int getindivs(char *indivfname, Indiv ***indmarkpt) {
- static Indiv **indivmarkers ;
- int nindiv, i ;
-
- if (indivfname == NULL) fatalx("(getindivs) NULL indivfname\n") ;
- nindiv = getsizex(indivfname) ;
- if (nindiv <= 0) fatalx("no indivs found: indivname: %s\n", indivfname) ;
- ZALLOC(indivmarkers, nindiv, Indiv *) ;
-
- for (i=0; i<nindiv; i++) {
- ZALLOC(indivmarkers[i], 1, Indiv) ;
- }
- clearind(indivmarkers, nindiv) ;
- *indmarkpt = indivmarkers ;
- readinddata(indivmarkers, indivfname) ;
- return nindiv ;
+int
+getindivs (char *indivfname, Indiv ***indmarkpt)
+{
+ static Indiv **indivmarkers;
+ int nindiv, i;
+
+ if (indivfname == NULL)
+ fatalx ("(getindivs) NULL indivfname\n");
+ nindiv = getsizex (indivfname);
+ if (nindiv <= 0)
+ fatalx ("no indivs found: indivname: %s\n", indivfname);
+ ZALLOC(indivmarkers, nindiv, Indiv *);
+
+ for (i = 0; i < nindiv; i++)
+ {
+ ZALLOC(indivmarkers[i], 1, Indiv);
+ }
+ clearind (indivmarkers, nindiv);
+ *indmarkpt = indivmarkers;
+ readinddata (indivmarkers, indivfname);
+ return nindiv;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int readinddata(Indiv **indivmarkers, char *fname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- int skipit ;
- Indiv *indx ;
+int
+readinddata (Indiv **indivmarkers, char *fname)
+{
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k;
+ int skipit;
+ Indiv *indx;
- FILE *fff ;
+ FILE *fff;
// Call routine to read PLINK format file
- if (ispedfile(fname)) {
- plinkinputmode = YES ;
- return readindpeddata(indivmarkers, fname) ;
- }
+ if (ispedfile (fname))
+ {
+ plinkinputmode = YES;
+ return readindpeddata (indivmarkers, fname);
+ }
// Read ANCESTRYMAP/EIGENSTRAT format individual file
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<3) fatalx("%s bad line: %s", fname, line) ;
- indx = indivmarkers[num] ;
- if (strlen(sx)>=IDSIZE) fatalx("ID too long: %s\n", sx) ;
- strcpy(indx->ID, sx) ;
- indx -> idnum = num ;
- sx = spt[1] ;
- indx -> gender = sx[0] ;
- indx -> affstatus = indx -> ignore = NO ;
- indx -> flag = 0 ;
- sx = spt[2] ;
- if (strcmp(sx, "Ignore") == 0) indx->ignore = YES ;
- if ((qtmode) && (!indx->ignore)) { // store quantitative phenotype in qval
- indx -> egroup = strdup("Case") ;
- indx -> qval = indx -> rawqval = atof(sx) ;
- }
- else {
- indx -> egroup = strdup(sx) ; // store discrete phenotype in egroup
- }
- // affstatus set by setstatus
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- return num ;
+ openit (fname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = setskipit (sx);
+ if (skipit == NO)
+ {
+ if (nsplit < 3)
+ fatalx ("%s bad line: %s", fname, line);
+ indx = indivmarkers[num];
+ if (strlen (sx) >= IDSIZE)
+ fatalx ("ID too long: %s\n", sx);
+ strcpy (indx->ID, sx);
+ indx->idnum = num;
+ sx = spt[1];
+ indx->gender = sx[0];
+ indx->affstatus = indx->ignore = NO;
+ indx->flag = 0;
+ sx = spt[2];
+ if (strcmp (sx, "Ignore") == 0)
+ indx->ignore = YES;
+ if ((qtmode) && (!indx->ignore))
+ { // store quantitative phenotype in qval
+ indx->egroup = strdup ("Case");
+ indx->qval = indx->rawqval = atof (sx);
+ }
+ else
+ {
+ indx->egroup = strdup (sx); // store discrete phenotype in egroup
+ }
+ // affstatus set by setstatus
+ ++num;
+ }
+ freeup (spt, nsplit);
+ continue;
+ }
+ fclose (fff);
+ return num;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int readindpeddata(Indiv **indivmarkers, char *fname) {
- char *line ;
- char *spt[MAXFF], *sx, *sx0, gender ;
- int nsplit, num=0, k, i ;
- int skipit ;
- Indiv *indx ;
- int nindiv ;
- int maxnsplit = 0 ;
- char nnbuff[IDSIZE] ;
- int nok = 0 ;
-
- FILE *fff ;
-
- maxgenolinelength = maxlinelength(fname) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
- openit(fname, &fff, "r") ;
-
- while (fgets(line, maxgenolinelength, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx0 = sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- if (skipit == NO) {
- if (nsplit<6) fatalx("%s bad line: %s", fname, line) ;
- indx = indivmarkers[num] ;
- if (strlen(sx)>=IDSIZE) fatalx("ID too long: %s\n", sx) ;
- maxnsplit = MAX(maxnsplit, nsplit) ;
-
- sx = spt[1] ;
- pedname(nnbuff, sx0, sx) ;
- strcpy(indx->ID, nnbuff) ;
- indx -> idnum = num ;
- sx = spt[4] ;
- k = atoi(sx) ;
- gender = 'U' ;
- if (k==1) gender = 'M' ;
- if (k==2) gender = 'F' ;
- indx -> gender = gender ;
- indx -> affstatus = indx -> ignore = NO ;
- indx -> flag = 0 ;
-
- sx = spt[5] ;
- if (qtmode) {
- indx -> egroup = strdup("Case") ;
- indx -> qval = indx -> rawqval = atof(sx) ;
- }
- else {
- k = 99 ;
- if (strcmp(sx, "-9") == 0) k = -9 ;
- if (strcmp(sx, "9") == 0) k = 9 ;
- if (strcmp(sx, "0") == 0) k = 0 ;
- if ((pedignore == NO) && (k==0)) k = 3 ;
- if (strcmp(sx, "1") == 0) k = 1 ;
- if (strcmp(sx, "2") == 0) k = 2 ;
- switch (k) {
- case 9:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case -9:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case 0:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case 1:
- indx -> egroup = strdup("Control") ;
- break ;
- case 2:
- indx -> egroup = strdup("Case") ;
- break ;
- case 3:
- indx -> egroup = strdup("???") ;
- break ;
- default:
- indx -> egroup = strdup(sx) ;
+int
+readindpeddata (Indiv **indivmarkers, char *fname)
+{
+ char *line;
+ char *spt[MAXFF], *sx, *sx0, gender;
+ int nsplit, num = 0, k, i;
+ int skipit;
+ Indiv *indx;
+ int nindiv;
+ int maxnsplit = 0;
+ char nnbuff[IDSIZE];
+ int nok = 0;
+
+ FILE *fff;
+
+ maxgenolinelength = maxlinelength (fname);
+ ZALLOC(line, maxgenolinelength+1, char);
+ openit (fname, &fff, "r");
+
+ while (fgets (line, maxgenolinelength, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx0 = sx = spt[0];
+ skipit = NO;
+ if (sx[0] == '#')
+ skipit = YES;
+ if (skipit == NO)
+ {
+ if (nsplit < 6)
+ fatalx ("%s bad line: %s", fname, line);
+ indx = indivmarkers[num];
+ if (strlen (sx) >= IDSIZE)
+ fatalx ("ID too long: %s\n", sx);
+ maxnsplit = MAX(maxnsplit, nsplit);
+
+ sx = spt[1];
+ pedname (nnbuff, sx0, sx);
+ strcpy (indx->ID, nnbuff);
+ indx->idnum = num;
+ sx = spt[4];
+ k = atoi (sx);
+ gender = 'U';
+ if (k == 1)
+ gender = 'M';
+ if (k == 2)
+ gender = 'F';
+ indx->gender = gender;
+ indx->affstatus = indx->ignore = NO;
+ indx->flag = 0;
+
+ sx = spt[5];
+ if (qtmode)
+ {
+ indx->egroup = strdup ("Case");
+ indx->qval = indx->rawqval = atof (sx);
+ }
+ else
+ {
+ k = 99;
+ if (strcmp (sx, "-9") == 0)
+ k = -9;
+ if (strcmp (sx, "9") == 0)
+ k = 9;
+ if (strcmp (sx, "0") == 0)
+ k = 0;
+ if ((pedignore == NO) && (k == 0))
+ k = 3;
+ if (strcmp (sx, "1") == 0)
+ k = 1;
+ if (strcmp (sx, "2") == 0)
+ k = 2;
+ switch (k)
+ {
+ case 9:
+ indx->ignore = YES;
+ printf ("%s ignored\n", indx->ID);
+ break;
+ case -9:
+ indx->ignore = YES;
+ printf ("%s ignored\n", indx->ID);
+ break;
+ case 0:
+ indx->ignore = YES;
+ printf ("%s ignored\n", indx->ID);
+ break;
+ case 1:
+ indx->egroup = strdup ("Control");
+ break;
+ case 2:
+ indx->egroup = strdup ("Case");
+ break;
+ case 3:
+ indx->egroup = strdup ("???");
+ break;
+ default:
+ indx->egroup = strdup (sx);
+ }
+ }
+
+ // affstatus set by setstatus
+ if (indx->ignore == NO)
+ ++nok;
+ ++num;
}
- }
-
- // affstatus set by setstatus
- if (indx -> ignore == NO) ++nok;
- ++num ;
+ freeup (spt, nsplit);
+ continue;
}
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nok == 0) {
- printf("all individuals set ignore. Likely input problem (col 6)\n") ;
- printf("resetting all individual...\n") ;
- for (i=0; i<num; i++) {
- indx = indivmarkers[i] ;
- indx -> ignore = NO ;
- indx -> egroup = strdup("???") ;
+ if (nok == 0)
+ {
+ printf ("all individuals set ignore. Likely input problem (col 6)\n");
+ printf ("resetting all individual...\n");
+ for (i = 0; i < num; i++)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = NO;
+ indx->egroup = strdup ("???");
+ }
}
- }
- if (maxnsplit<8) maxgenolinelength = -1 ;
- free(line) ;
+ if (maxnsplit < 8)
+ maxgenolinelength = -1;
+ free (line);
- fclose(fff) ;
- return num ;
+ fclose (fff);
+ return num;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void pedname(char *cbuff, char *sx0, char *sx1) {
- int l0 , l1, ll ;
-
- l0 = strlen(sx0) ;
- l1 = strlen(sx1) ;
- ll = l0 +l1 + 1 ;
- if (familynames == NO) ll = l1 ;
- if (ll>=IDSIZE) {
- fatalx("idnames too long %s %s ll: %d limit: %d\n", sx0, sx1, ll, IDSIZE-1) ;
- }
- if (familynames == YES) { // prepend family name to individual name
- strcpy(cbuff, sx0) ;
- cbuff[l0] = ':' ;
- strcpy(cbuff+l0+1, sx1) ;
- return ;
- }
- strcpy(cbuff, sx1) ;
+void
+pedname (char *cbuff, char *sx0, char *sx1)
+{
+ int l0, l1, ll;
+
+ l0 = strlen (sx0);
+ l1 = strlen (sx1);
+ ll = l0 + l1 + 1;
+ if (familynames == NO)
+ ll = l1;
+ if (ll >= IDSIZE)
+ {
+ fatalx ("idnames too long %s %s ll: %d limit: %d\n", sx0, sx1, ll,
+ IDSIZE - 1);
+ }
+ if (familynames == YES)
+ { // prepend family name to individual name
+ strcpy (cbuff, sx0);
+ cbuff[l0] = ':';
+ strcpy (cbuff + l0 + 1, sx1);
+ return;
+ }
+ strcpy (cbuff, sx1);
}
-
+
/* ---------------------------------------------------------------------------------------------------- */
-int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname) {
+int
+readtldata (Indiv **indivmarkers, int numindivs, char *inddataname)
+{
// warning printed if theta/lambda not in file
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind, i ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
- int *xcheck ;
-
- FILE *fff ;
- ZALLOC(xcheck, numindivs, int) ;
- openit(inddataname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (strcmp(sx, "Indiv_Index") == 0) {
- // hack. thetafile should be output with leading ##
- freeup(spt, nsplit) ;
- continue ;
- }
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<8) fatalx("%s bad line: %s", inddataname, line) ;
- sx = spt[1] ;
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readtldata) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
-
- indx -> theta_mode = atof(spt[3]) ;
- indx -> lambda_mode = atof(spt[7]) ;
- indx -> Xtheta_mode = atof(spt[5]) ;
- indx -> Xlambda_mode = atof(spt[9]) ;
- xcheck[ind] = 1 ;
-
- freeup(spt, nsplit) ;
- continue ;
- }
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- if (xcheck[i] == 1) continue ;
- printf("*** warning (readtldata) ") ;
- printf("%s not found in tlname file", indx -> ID) ;
- printnl() ;
- }
-
- free (xcheck) ;
- fclose(fff) ;
- return num ;
-}
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k, ind, i;
+ int skipit;
+ Indiv *indx;
+ double y;
+ double gg[3];
+ int *xcheck;
+
+ FILE *fff;
+ ZALLOC(xcheck, numindivs, int);
+ openit (inddataname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = NO;
+ if (strcmp (sx, "Indiv_Index") == 0)
+ {
+ // hack. thetafile should be output with leading ##
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < 8)
+ fatalx ("%s bad line: %s", inddataname, line);
+ sx = spt[1];
+ ind = indindex (indivmarkers, numindivs, sx);
+ if (ind < 0)
+ fatalx ("(readtldata) indiv: %s not found \n", sx);
+ indx = indivmarkers[ind];
+
+ indx->theta_mode = atof (spt[3]);
+ indx->lambda_mode = atof (spt[7]);
+ indx->Xtheta_mode = atof (spt[5]);
+ indx->Xlambda_mode = atof (spt[9]);
+ xcheck[ind] = 1;
+
+ freeup (spt, nsplit);
+ continue;
+ }
+ for (i = 0; i < numindivs; ++i)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ if (xcheck[i] == 1)
+ continue;
+ printf ("*** warning (readtldata) ");
+ printf ("%s not found in tlname file", indx->ID);
+ printnl ();
+ }
+ free (xcheck);
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int readfreqdata(SNP **snpm, int numsnps, char *inddataname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- SNP *cupt ;
-
- FILE *fff ;
- openit(inddataname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<6) fatalx("%s bad line: %s", inddataname, line) ;
- sx = spt[2] ;
- ind = snpindex(snpm, numsnps, sx) ;
- if (ind<0) fatalx("(readfreqdata) snp %s not found \n", sx) ;
- cupt = snpm[ind] ;
- cupt -> aa_af_freq = cupt -> af_freq = atof(spt[3]) ;
- cupt -> aa_cauc_freq = cupt -> cauc_freq = atof(spt[5]) ;
-
- freeup(spt, nsplit) ;
- ++num ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
+int
+readfreqdata (SNP **snpm, int numsnps, char *inddataname)
+{
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k, ind;
+ int skipit;
+ SNP *cupt;
+ FILE *fff;
+ openit (inddataname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = NO;
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < 6)
+ fatalx ("%s bad line: %s", inddataname, line);
+ sx = spt[2];
+ ind = snpindex (snpm, numsnps, sx);
+ if (ind < 0)
+ fatalx ("(readfreqdata) snp %s not found \n", sx);
+ cupt = snpm[ind];
+ cupt->aa_af_freq = cupt->af_freq = atof (spt[3]);
+ cupt->aa_cauc_freq = cupt->cauc_freq = atof (spt[5]);
+
+ freeup (spt, nsplit);
+ ++num;
+ continue;
+ }
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int setstatus(Indiv **indm, int numindivs, char *smatch) {
+int
+setstatus (Indiv **indm, int numindivs, char *smatch)
+{
// return number set
// smatch = NULL => set everything
- return setstatusv(indm, numindivs, smatch, YES) ;
+ return setstatusv (indm, numindivs, smatch, YES);
}
/* ---------------------------------------------------------------------------------------------------- */
-int setstatusv(Indiv **indm, int numindivs, char *smatch, int val) {
+int
+setstatusv (Indiv **indm, int numindivs, char *smatch, int val)
+{
// return number set
// smatch = NULL => set everything
- int i, n=0 ;
- Indiv *indx ;
- char *sx ;
- for (i=0; i<numindivs; i++) {
- indx = indm[i] ;
- if (indx -> ignore) continue ;
- sx = indx -> egroup ;
- if (smatch == NULL) {
- ++n ;
- indx->affstatus = val ;
- continue ;
- }
- if (strcmp(sx, smatch) == 0) {
- ++n ;
- indx->affstatus += val ;
- }
- if (indx -> affstatus >1) fatalx("aff2bug\n") ;
- }
- return n ;
-}
-
+ int i, n = 0;
+ Indiv *indx;
+ char *sx;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indm[i];
+ if (indx->ignore)
+ continue;
+ sx = indx->egroup;
+ if (smatch == NULL)
+ {
+ ++n;
+ indx->affstatus = val;
+ continue;
+ }
+ if (strcmp (sx, smatch) == 0)
+ {
+ ++n;
+ indx->affstatus += val;
+ }
+ if (indx->affstatus > 1)
+ fatalx ("aff2bug\n");
+ }
+ return n;
+}
/* ---------------------------------------------------------------------------------------------------- */
-long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) {
+long
+getgenos (char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs, int nignore)
+{
// read genofile. Use hashtable to improve search
// if genofile is gzipped decompress to trashdir
- char *gname, *genotmp = NULL ;
- ENTRY *hashlist, *iteml ;
- ENTRY item1 ;
- int k, num, indiv, lgt ;
- int val ;
- void *basept = 0 ;
- int bigoff ;
- int tcheck ;
+ char *gname, *genotmp = NULL;
+ ENTRY *hashlist, *iteml;
+ ENTRY item1;
+ int k, num, indiv, lgt;
+ int val;
+ void *basept = 0;
+ int bigoff;
+ int tcheck;
// we use a trick: want to store k
// store basept + k instead
// basept + k + bigoff for individual ID
- SNP *cupt ;
- Indiv *indx ;
+ SNP *cupt;
+ Indiv *indx;
- char line[MAXSTR], cmd[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, nsnp ;
- int skipit, kret, tpackmode, teigenstratmode ;
+ char line[MAXSTR], cmd[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, nsnp;
+ int skipit, kret, tpackmode, teigenstratmode;
- FILE *fff ;
- int gnlen, ngenos=0 ;
+ FILE *fff;
+ int gnlen, ngenos = 0;
- double y ;
- char *pbuff ;
+ double y;
+ char *pbuff;
- item1.key = NULL ;
- item1.data = NULL ;
+ item1.key = NULL;
+ item1.data = NULL;
- if (genoname == NULL) fatalx("(getgenos) NULL genoname\n") ;
- gname = genoname ;
- gnlen = strlen(genoname) ;
+ if (genoname == NULL)
+ fatalx ("(getgenos) NULL genoname\n");
+ gname = genoname;
+ gnlen = strlen (genoname);
// Unzip file if necessary
- if (strcmp(genoname+gnlen-3, ".gz") == 0) {
- makedir(trashdir) ;
- sprintf(line, "%s/genotmp:%d", trashdir, getpid()) ;
- genotmp = strdup(line) ;
- sprintf(cmd, "gunzip -c %s > %s", genoname, genotmp) ;
- printf("unzip cmd: %s\n", cmd) ;
- system (cmd) ;
- kret = system (cmd) ;
- if (kret<0) {
- perror("gunzip failed\n") ;
- fatalx("gunzip failed... probably out of disk space\n") ;
- }
- printf("geno file unzipped\n") ;
- gname = genotmp ;
- }
+ if (strcmp (genoname + gnlen - 3, ".gz") == 0)
+ {
+ makedir (trashdir);
+ sprintf (line, "%s/genotmp:%d", trashdir, getpid ());
+ genotmp = strdup (line);
+ sprintf (cmd, "gunzip -c %s > %s", genoname, genotmp);
+ printf ("unzip cmd: %s\n", cmd);
+ system (cmd);
+ kret = system (cmd);
+ if (kret < 0)
+ {
+ perror ("gunzip failed\n");
+ fatalx ("gunzip failed... probably out of disk space\n");
+ }
+ printf ("geno file unzipped\n");
+ gname = genotmp;
+ }
// Enforce data size limits
- tcheck = checksize(numsnps, numindivs, outputmode) ;
- if (tcheck == -2) fatalx("Data sets with more than 8 billion genotypes are not permitted\n") ;
- if (tcheck == -1) fatalx("Output files of size >2GB are not permitted: use a more compact output data format. Also see documentation of chrom, badsnpname and checksizemode parameters.\n") ;
+ tcheck = checksize (numsnps, numindivs, outputmode);
+ if (tcheck == -2)
+ fatalx ("Data sets with more than 8 billion genotypes are not permitted\n");
+ if (tcheck == -1)
+ fatalx (
+ "Output files of size >2GB are not permitted: use a more compact output data format. Also see documentation of chrom, badsnpname and checksizemode parameters.\n");
// Call routine to read PLINK format unpacked genotype file
- if (ispedfile(gname)) {
-
- if (snpord == NULL) fatalx("snpord not allocated (no map file ?)") ;
- getpedgenos(genoname, snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
- freeped() ;
- return numsnps*numindivs ;
- }
+ if (ispedfile (gname))
+ {
+
+ if (snpord == NULL)
+ fatalx ("snpord not allocated (no map file ?)");
+ getpedgenos (genoname, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
+ freeped ();
+ return numsnps * numindivs;
+ }
// Call routine to read PLINK format packed genotype file
- if (isbedfile(gname)) {
- return getbedgenos(genoname, snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
- }
+ if (isbedfile (gname))
+ {
+ return getbedgenos (genoname, snpmarkers, indivmarkers, numsnps,
+ numindivs, nignore);
+ }
// Check whether file is packed ANCESTRYMAP format (packed EIGENSTRAT does not exist)
- tpackmode = ispack(gname) ;
- nsnp = numsnps ;
+ tpackmode = ispack (gname);
+ nsnp = numsnps;
// Call routine to read packed ANCESTRYMAP format
- if (tpackmode) {
- inpack(gname, snpmarkers, indivmarkers, nsnp, numindivs) ;
- for (k=0; k<nsnp; k++) {
- cupt = snpmarkers[k] ;
- if (cupt -> ignore) continue ;
- if ((cupt -> isfake) && (!(cupt -> isrfake))) continue ;
- cupt -> ngtypes = numindivs ;
- if (cupt -> gtypes == NULL) ZALLOC(cupt -> gtypes, 1, int) ;
+ if (tpackmode)
+ {
+ inpack (gname, snpmarkers, indivmarkers, nsnp, numindivs);
+ for (k = 0; k < nsnp; k++)
+ {
+ cupt = snpmarkers[k];
+ if (cupt->ignore)
+ continue;
+ if ((cupt->isfake) && (!(cupt->isrfake)))
+ continue;
+ cupt->ngtypes = numindivs;
+ if (cupt->gtypes == NULL)
+ ZALLOC(cupt -> gtypes, 1, int);
+ }
+ packmode = YES;
+ return nsnp * numindivs;
}
- packmode = YES ;
- return nsnp*numindivs ;
- }
- teigenstratmode = iseigenstrat(gname) ;
+ teigenstratmode = iseigenstrat (gname);
// Call routine to read EIGENSTRAT format
- if (teigenstratmode) {
- packmode = YES ;
- ineigenstrat(gname, snpmarkers, indivmarkers, nsnp, numindivs) ;
- freeped() ;
- return nsnp*numindivs ;
- }
-
+ if (teigenstratmode)
+ {
+ packmode = YES;
+ ineigenstrat (gname, snpmarkers, indivmarkers, nsnp, numindivs);
+ freeped ();
+ return nsnp * numindivs;
+ }
// (If execution reaches here, the file is unpacked ANCESTRYMAP format)
-
+
// rlen is number of bytes needed to store each SNP's genotype data
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- packlen = rlen*numsnps ;
- if (packlen<0) fatalx("yuckk\n") ;
- if (packmode) {
- ZALLOC(packgenos, packlen, char) ;
- pbuff = packgenos ;
- clearepath(packgenos) ;
- }
+ y = (double) (numindivs * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ packlen = rlen * numsnps;
+ if (packlen < 0)
+ fatalx ("yuckk\n");
+ if (packmode)
+ {
+ ZALLOC(packgenos, packlen, char);
+ pbuff = packgenos;
+ clearepath (packgenos);
+ }
// instantiate hash table
- num = nsnp + numindivs ;
- xhcreate(5*num) ;
- ZALLOC(hashlist, num, ENTRY) ;
- bigoff = nsnp + 100 ;
+ num = nsnp + numindivs;
+ xhcreate (5 * num);
+ ZALLOC(hashlist, num, ENTRY);
+ bigoff = nsnp + 100;
// hash SNPs (key=name, value=index in snpmarkers)
- for (k=0; k<nsnp; k++) {
- cupt = snpmarkers[k] ;
- if ((cupt -> isfake) && (!(cupt -> isrfake))) continue ;
- iteml = hashlist+k ;
- iteml -> key = cupt->ID ;
- iteml -> data = basept +k ;
- if (xhsearch(*iteml, FIND) != NULL)
- fatalx("duplicate ID: %s\n", iteml -> key) ;
- (void) xhsearch(*iteml, ENTER) ;
- }
+ for (k = 0; k < nsnp; k++)
+ {
+ cupt = snpmarkers[k];
+ if ((cupt->isfake) && (!(cupt->isrfake)))
+ continue;
+ iteml = hashlist + k;
+ iteml->key = cupt->ID;
+ iteml->data = basept + k;
+ if (xhsearch (*iteml, FIND) != NULL)
+ fatalx ("duplicate ID: %s\n", iteml->key);
+ (void) xhsearch (*iteml, ENTER);
+ }
// hash individuals (key=name, value=index in indivmarkers)
- for (k=0; k<numindivs; k++) {
-
- indx = indivmarkers[k] ;
- iteml = hashlist+numsnps+k ;
- iteml -> key = indx->ID ;
- iteml -> data = basept+k+bigoff ;
- if (xhsearch(*iteml, FIND) != NULL)
- fatalx("duplicate ID: %s\n", iteml -> key);
- (void) xhsearch(*iteml, ENTER) ;
- }
+ for (k = 0; k < numindivs; k++)
+ {
+
+ indx = indivmarkers[k];
+ iteml = hashlist + numsnps + k;
+ iteml->key = indx->ID;
+ iteml->data = basept + k + bigoff;
+ if (xhsearch (*iteml, FIND) != NULL)
+ fatalx ("duplicate ID: %s\n", iteml->key);
+ (void) xhsearch (*iteml, ENTER);
+ }
// read genotype file
- openit(gname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<3) fatalx("bad geno line. missing field?\n", line) ;
-
- // Look up SNP and individual indices in hash table
- item1.key = spt[0] ;
- iteml = xhsearch(item1, FIND) ;
- if (iteml == NULL) {
- fatalx("(genotypes) bad ID (SNP): %s\n", line) ;
- }
- k = (int) (iteml->data - basept) ;
-
- if (k>=numsnps) {
- fatalx("bad genotype line: `snp' may be Indiv Id\n%s\n", line) ;
- }
-
- cupt = snpmarkers[k] ;
- if (cupt -> ignore) {
- freeup(spt, nsplit) ;
- continue ;
- }
- item1.key = spt[1] ;
- iteml = xhsearch(item1, FIND) ;
- if (iteml == NULL) {
- fatalx("(genotypes) bad ID: (Indiv) %s\n", line) ;
- }
- indiv = (int) (iteml->data - basept) ;
- indiv -= bigoff ;
- val = atoi(spt[2]) ;
-
- indx = indivmarkers[indiv] ;
- if (indx->ignore) val = -1 ;
- if (checkxval(cupt, indx, val) == NO) val = -1 ;
- if (val>2) {
- printf("*** warning invalid genotype: %s %s %d\n",
- cupt -> ID, indx -> ID, val) ;
- val = -1 ;
- }
-
- if (cupt -> ngtypes == 0) {
-
- // If this is the first datum for this SNP, initialize
- // Set cupt->puff to point to the SNP's data in the genotype array.
- // Set cupt->gtypes to the number of individuals stored in the genotype.
-
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numindivs, int) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numindivs ;
- for (k=0; k<numindivs; ++k) {
- putgtypes(cupt, k, -1) ; // initialize all individuals to "missing data"
+ openit (gname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = NO;
+ if (sx[0] == '#')
+ skipit = YES;
+ skipit = setskipit (sx);
+ if (skipit == NO)
+ {
+ if (nsplit < 3)
+ fatalx ("bad geno line. missing field?\n", line);
+
+ // Look up SNP and individual indices in hash table
+ item1.key = spt[0];
+ iteml = xhsearch (item1, FIND);
+ if (iteml == NULL)
+ {
+ fatalx ("(genotypes) bad ID (SNP): %s\n", line);
+ }
+ k = (int) (iteml->data - basept);
+
+ if (k >= numsnps)
+ {
+ fatalx ("bad genotype line: `snp' may be Indiv Id\n%s\n", line);
+ }
+
+ cupt = snpmarkers[k];
+ if (cupt->ignore)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ item1.key = spt[1];
+ iteml = xhsearch (item1, FIND);
+ if (iteml == NULL)
+ {
+ fatalx ("(genotypes) bad ID: (Indiv) %s\n", line);
+ }
+ indiv = (int) (iteml->data - basept);
+ indiv -= bigoff;
+ val = atoi (spt[2]);
+
+ indx = indivmarkers[indiv];
+ if (indx->ignore)
+ val = -1;
+ if (checkxval (cupt, indx, val) == NO)
+ val = -1;
+ if (val > 2)
+ {
+ printf ("*** warning invalid genotype: %s %s %d\n", cupt->ID,
+ indx->ID, val);
+ val = -1;
+ }
+
+ if (cupt->ngtypes == 0)
+ {
+
+ // If this is the first datum for this SNP, initialize
+ // Set cupt->puff to point to the SNP's data in the genotype array.
+ // Set cupt->gtypes to the number of individuals stored in the genotype.
+
+ if (packmode == NO)
+ {
+ ZALLOC(cupt -> gtypes, numindivs, int);
+ }
+ else
+ {
+ ZALLOC(cupt -> gtypes, 1, int);
+ cupt->pbuff = pbuff;
+ pbuff += rlen;
+ }
+ cupt->ngtypes = numindivs;
+ for (k = 0; k < numindivs; ++k)
+ {
+ putgtypes (cupt, k, -1); // initialize all individuals to "missing data"
+ }
+ }
+ putgtypes (cupt, indiv, val); // store this individual's genotype at this SNP
+ ++ngenos;
}
- }
- putgtypes(cupt, indiv, val) ; // store this individual's genotype at this SNP
- ++ngenos ;
+ freeup (spt, nsplit);
}
- freeup(spt, nsplit) ;
- }
- fclose(fff) ;
+ fclose (fff);
// destroy hash table
- free(hashlist) ;
- xhdestroy() ;
-
+ free (hashlist);
+ xhdestroy ();
// if this is a temporary file (gunzipped), delete it
- if (genotmp != NULL) {
- unlink(gname) ;
- }
+ if (genotmp != NULL)
+ {
+ unlink (gname);
+ }
/* printf("genotype file processed\n") ; */
- freeped() ;
- return ngenos ;
+ freeped ();
+ return ngenos;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void freeped() {
+void
+freeped ()
+{
// destructor for snpord
- if (snpord == NULL) return ;
- if (dofreeped == NO) return ;
- free(snpord) ;
- snpord = NULL ;
- numsnpord = 0 ;
- maxgenolinelength = -1 ;
+ if (snpord == NULL)
+ return;
+ if (dofreeped == NO)
+ return;
+ free (snpord);
+ snpord = NULL;
+ numsnpord = 0;
+ maxgenolinelength = -1;
}
/* ---------------------------------------------------------------------------------------------------- */
-int checkxval(SNP *cupt, Indiv *indx, int val) {
+int
+checkxval (SNP *cupt, Indiv *indx, int val)
+{
// check Male X marker not het
- if (cupt -> chrom != numchrom+1) return YES ;
- if (indx -> gender != 'M') return YES ;
- if (val != 1) return YES ;
- if (malexhet) return YES ;
- return NO;
+ if (cupt->chrom != numchrom + 1)
+ return YES;
+ if (indx->gender != 'M')
+ return YES;
+ if (val != 1)
+ return YES;
+ if (malexhet)
+ return YES;
+ return NO;
}
/* ---------------------------------------------------------------------------------------------------- */
-void clearsnp(SNP *cupt) {
-
- cupt -> af_freq =
- cupt -> cauc_freq = -1 ;
- cupt -> aa_af_freq =
- cupt -> aa_cauc_freq = -1 ;
- cupt -> estgenpos = 0 ;
- cupt -> genpos = 0 ;
- cupt -> physpos = 0 ;
- cupt -> ngtypes = 0 ;
- cupt -> pbuff = NULL ;
- cupt -> ebuff = NULL ;
- cupt -> gtypes = NULL ;
- cupt -> modelscores = NULL ;
- cupt -> totmodelscores = NULL ;
- cupt -> score = cupt -> weight = 0.0 ;
- cupt -> isfake = NO ;
- cupt -> ignore = NO ;
- cupt -> isrfake = NO ;
- cupt -> estdis = 0 ;
- cupt -> dis = 0 ;
- cupt -> esum = 0 ;
- cupt -> lsum = 0 ;
- cupt -> gpsum = 0 ;
- cupt -> gpnum = 0 ;
- cupt -> pcupt = NULL ;
- cupt -> tagnumber = -1 ;
- cclear(cupt -> cchrom, CNULL, 7) ;
- strcpy(cupt -> cchrom, "") ;
- cupt -> chimpfudge = NO ;
- cclear((unsigned char *) cupt -> alleles, CNULL, 2) ;
+void
+clearsnp (SNP *cupt)
+{
+
+ cupt->af_freq = cupt->cauc_freq = -1;
+ cupt->aa_af_freq = cupt->aa_cauc_freq = -1;
+ cupt->estgenpos = 0;
+ cupt->genpos = 0;
+ cupt->physpos = 0;
+ cupt->ngtypes = 0;
+ cupt->pbuff = NULL;
+ cupt->ebuff = NULL;
+ cupt->gtypes = NULL;
+ cupt->modelscores = NULL;
+ cupt->totmodelscores = NULL;
+ cupt->score = cupt->weight = 0.0;
+ cupt->isfake = NO;
+ cupt->ignore = NO;
+ cupt->isrfake = NO;
+ cupt->estdis = 0;
+ cupt->dis = 0;
+ cupt->esum = 0;
+ cupt->lsum = 0;
+ cupt->gpsum = 0;
+ cupt->gpnum = 0;
+ cupt->pcupt = NULL;
+ cupt->tagnumber = -1;
+ cclear (cupt->cchrom, CNULL, 7);
+ strcpy (cupt->cchrom, "");
+ cupt->chimpfudge = NO;
+ cclear ((unsigned char *) cupt->alleles, CNULL, 2);
}
/* ---------------------------------------------------------------------------------------------------- */
-int rmindivs(SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs) {
+int
+rmindivs (SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs)
+{
// squeeze out ignore
// dangerous bend. Of course indivmarkers indexing will change
- int n = 0, g, i, k ;
- int x ;
- Indiv *indx ;
- SNP *cupt ;
+ int n = 0, g, i, k;
+ int x;
+ Indiv *indx;
+ SNP *cupt;
// n is index of next unused array element
- for (k=0; k<numindivs; ++k) {
- if (indivmarkers[k] -> ignore == YES) continue ; // don't store
- if (n==k) { // if no ignored found yet,
- ++n ; // next unused is next element
- continue ; // and no need to copy
- }
-
- // copy k -> n
- indx = indivmarkers[n] ; // if kth element is not ignored, put it
- indivmarkers[n] = indivmarkers[k] ; // into next unused element
- indx -> idnum = n ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> gtypes == NULL) break ;
- if (cupt -> ignore) continue ; // copy only genotypes of non-ignored SNPs
- g = getgtypes(cupt, k) ;
- putgtypes(cupt, n, g) ;
- }
- ++n ;
- }
-
- for (i=0; i<numsnps; i++) { // reset number of individuals
- cupt = snpm[i] ;
- cupt -> ngtypes = n ;
- }
- return n ;
+ for (k = 0; k < numindivs; ++k)
+ {
+ if (indivmarkers[k]->ignore == YES)
+ continue; // don't store
+ if (n == k)
+ { // if no ignored found yet,
+ ++n; // next unused is next element
+ continue; // and no need to copy
+ }
+
+ // copy k -> n
+ indx = indivmarkers[n]; // if kth element is not ignored, put it
+ indivmarkers[n] = indivmarkers[k]; // into next unused element
+ indx->idnum = n;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->gtypes == NULL)
+ break;
+ if (cupt->ignore)
+ continue; // copy only genotypes of non-ignored SNPs
+ g = getgtypes (cupt, k);
+ putgtypes (cupt, n, g);
+ }
+ ++n;
+ }
+
+ for (i = 0; i < numsnps; i++)
+ { // reset number of individuals
+ cupt = snpm[i];
+ cupt->ngtypes = n;
+ }
+ return n;
}
/* ---------------------------------------------------------------------------------------------------- */
-int rmsnps(SNP **snpm, int numsnps, char *deletesnpoutname) {
+int
+rmsnps (SNP **snpm, int numsnps, char *deletesnpoutname)
+{
- int i,x ;
- SNP *cupt ;
- int lastc, chrom ;
+ int i, x;
+ SNP *cupt;
+ int lastc, chrom;
- freesnpindex() ; // clear hash table
+ freesnpindex (); // clear hash table
// wipe out fakes not between real markers
- lastc = -1 ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- chrom = cupt -> chrom ;
- if ( (cupt -> isfake) && (chrom != lastc)) {
- cupt -> ignore = YES ; // precedes first real SNP
- logdeletedsnp(cupt->ID,"isfake",deletesnpoutname);
- }
- if (!cupt -> isfake) lastc = chrom ;
- }
-
- lastc = -1 ;
- for (i=numsnps-1; i>=0; i--) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- chrom = cupt -> chrom ;
- if ( (cupt -> isfake) && (chrom != lastc)) {
- cupt -> ignore = YES ; // follows last real SNP
- logdeletedsnp(cupt->ID,"isfake",deletesnpoutname);
- }
- if (!cupt -> isfake) lastc = chrom ;
- }
-
- x = 0 ; // index of next retained SNP in the array
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) {
- freecupt(&cupt) ;
- continue ;
- }
- snpm[x] = snpm[i] ;
- ++x ;
- }
+ lastc = -1;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->ignore)
+ continue;
+ chrom = cupt->chrom;
+ if ((cupt->isfake) && (chrom != lastc))
+ {
+ cupt->ignore = YES; // precedes first real SNP
+ logdeletedsnp (cupt->ID, "isfake", deletesnpoutname);
+ }
+ if (!cupt->isfake)
+ lastc = chrom;
+ }
+
+ lastc = -1;
+ for (i = numsnps - 1; i >= 0; i--)
+ {
+ cupt = snpm[i];
+ if (cupt->ignore)
+ continue;
+ chrom = cupt->chrom;
+ if ((cupt->isfake) && (chrom != lastc))
+ {
+ cupt->ignore = YES; // follows last real SNP
+ logdeletedsnp (cupt->ID, "isfake", deletesnpoutname);
+ }
+ if (!cupt->isfake)
+ lastc = chrom;
+ }
+
+ x = 0; // index of next retained SNP in the array
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->ignore)
+ {
+ freecupt (&cupt);
+ continue;
+ }
+ snpm[x] = snpm[i];
+ ++x;
+ }
// reset own-index field
- for (i=0; i<x; i++) {
- cupt = snpm[i] ;
- cupt -> markernum = i ;
- }
+ for (i = 0; i < x; i++)
+ {
+ cupt = snpm[i];
+ cupt->markernum = i;
+ }
- return x ;
+ return x;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void freecupt(SNP **cuppt) {
- SNP *cupt ;
- cupt = *cuppt ;
- if (cupt -> modelscores != NULL) {
- free(cupt->modelscores) ;
- }
- if (cupt -> totmodelscores != NULL) {
- free(cupt->totmodelscores) ;
- }
- free(cupt) ;
- cupt = NULL ;
+void
+freecupt (SNP **cuppt)
+{
+ SNP *cupt;
+ cupt = *cuppt;
+ if (cupt->modelscores != NULL)
+ {
+ free (cupt->modelscores);
+ }
+ if (cupt->totmodelscores != NULL)
+ {
+ free (cupt->totmodelscores);
+ }
+ free (cupt);
+ cupt = NULL;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void clearind(Indiv **indm, int numind) {
- Indiv *indx ;
- double theta ;
- int i ;
-
- for (i=0; i<numind; i++) {
- indx = indm[i] ;
- indx -> egroup = NULL ;
- indx -> affstatus = indx -> ignore = NO ;
- indx -> flag = 0 ;
- indx -> gender = 'U' ;
- indx = indm[i] ;
- indx -> Xtheta_mode = indx->theta_mode = a1/(a1+b1) ;
- indx -> Xlambda_mode = indx -> lambda_mode = lp1/lp2 ;
- indx -> thetatrue = -1.0 ; // silly value
- indx -> qval = indx -> rawqval = 0.0 ;
- }
- cleartg(indm, numind) ;
+void
+clearind (Indiv **indm, int numind)
+{
+ Indiv *indx;
+ double theta;
+ int i;
+
+ for (i = 0; i < numind; i++)
+ {
+ indx = indm[i];
+ indx->egroup = NULL;
+ indx->affstatus = indx->ignore = NO;
+ indx->flag = 0;
+ indx->gender = 'U';
+ indx = indm[i];
+ indx->Xtheta_mode = indx->theta_mode = a1 / (a1 + b1);
+ indx->Xlambda_mode = indx->lambda_mode = lp1 / lp2;
+ indx->thetatrue = -1.0; // silly value
+ indx->qval = indx->rawqval = 0.0;
+ }
+ cleartg (indm, numind);
}
/* ---------------------------------------------------------------------------------------------------- */
-void cleartg(Indiv **indm, int nind) {
- int i ;
- Indiv *indx ;
-
- for (i=0; i< nind; i++) {
- indx = indm[i] ;
- vzero(indx -> totgamms, 3) ;
- indx -> totscore = 0.0 ;
- }
-}
+void
+cleartg (Indiv **indm, int nind)
+{
+ int i;
+ Indiv *indx;
+ for (i = 0; i < nind; i++)
+ {
+ indx = indm[i];
+ vzero (indx->totgamms, 3);
+ indx->totscore = 0.0;
+ }
+}
/* ---------------------------------------------------------------------------------------------------- */
-double mknn(int *nn, int n0, int n1) {
- double x ;
- int t ;
+double
+mknn (int *nn, int n0, int n1)
+{
+ double x;
+ int t;
- nn[0] = n0 + 1 ;
- nn[1] = n1 + 1 ;
+ nn[0] = n0 + 1;
+ nn[1] = n1 + 1;
// no clipping. (Old code clipped here)
- t = intsum(nn,2) ;
- x = ((double) nn[0]) / (double) t ;
+ t = intsum (nn, 2);
+ x = ((double) nn[0]) / (double) t;
- return x ;
+ return x;
}
/* ---------------------------------------------------------------------------------------------------- */
-void setug(Indiv **indm, int numind, char gender) {
- Indiv *indx ;
- double theta ;
- int i ;
-
- for (i=0; i<numind; i++) {
- indx = indm[i] ;
- if (indx -> gender == 'U') indx -> gender = gender ;
- }
+void
+setug (Indiv **indm, int numind, char gender)
+{
+ Indiv *indx;
+ double theta;
+ int i;
+
+ for (i = 0; i < numind; i++)
+ {
+ indx = indm[i];
+ if (indx->gender == 'U')
+ indx->gender = gender;
+ }
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname) {
-
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *ss ;
- int indx, nsplit, n ;
-
- if (badsnpname == NULL) return ;
- openit (badsnpname, &fff, "r") ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- if (spt[0][0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- // look up index in snpraw
- indx = snprawindex(snpraw, nreal, spt[0]) ;
- if (indx >=0) {
- snpraw[indx] -> ignore = YES ;
- if ((nsplit >=2) && (checkfake(spt[1]))) {
- snpraw[indx] -> ignore = NO ;
- snpraw[indx] -> isrfake = YES ;
- }
- }
- freeup(spt, nsplit) ;
- }
- fclose (fff) ;
-}
+void
+dobadsnps (SNPDATA **snpraw, int nreal, char *badsnpname)
+{
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *ss;
+ int indx, nsplit, n;
+
+ if (badsnpname == NULL)
+ return;
+ openit (badsnpname, &fff, "r");
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ if (spt[0][0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ // look up index in snpraw
+ indx = snprawindex (snpraw, nreal, spt[0]);
+ if (indx >= 0)
+ {
+ snpraw[indx]->ignore = YES;
+ if ((nsplit >= 2) && (checkfake (spt[1])))
+ {
+ snpraw[indx]->ignore = NO;
+ snpraw[indx]->isrfake = YES;
+ }
+ }
+ freeup (spt, nsplit);
+ }
+ fclose (fff);
+}
/* ---------------------------------------------------------------------------------------------------- */
-int checkfake(char *ss) {
+int
+checkfake (char *ss)
+{
// yes if string ss is "Fake"
// ss is overwritten
- ss[0] = tolower(ss[0]) ;
- if (strcmp(ss,"fake") == 0) return YES ;
- return NO ;
+ ss[0] = tolower(ss[0]);
+ if (strcmp (ss, "fake") == 0)
+ return YES;
+ return NO;
}
-void mkchrom(char *ss, int chrom, double *ppos, int fudge, int chrmode)
+void
+mkchrom (char *ss, int chrom, double *ppos, int fudge, int chrmode)
{
- char *sx ;
- int big = 200*1000*1000 ;
-
- sx = ss ;
- if (chrmode) {
- strcpy(ss, "chr") ;
- sx += 3 ;
- }
- if ((chrom != 2) || (fudge == NO)) {
- sprintf(sx, "%d", chrom) ;
- return ;
- }
-
- if (*ppos <= big) {
- sprintf(sx, "2a") ;
- }
-
- if (*ppos > big) {
- sprintf(sx, "2b") ;
- *ppos -= big ;
- }
+ char *sx;
+ int big = 200 * 1000 * 1000;
+
+ sx = ss;
+ if (chrmode)
+ {
+ strcpy (ss, "chr");
+ sx += 3;
+ }
+ if ((chrom != 2) || (fudge == NO))
+ {
+ sprintf (sx, "%d", chrom);
+ return;
+ }
-}
+ if (*ppos <= big)
+ {
+ sprintf (sx, "2a");
+ }
+ if (*ppos > big)
+ {
+ sprintf (sx, "2b");
+ *ppos -= big;
+ }
-/* ---------------------------------------------------------------------------------------------------- */
-void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids) {
-
- int i, chrom ;
- double ppos ;
- SNP *cupt ;
- char ss[10] ;
- FILE *xfile ;
- int numvcase, numvcontrol ;
- char c ;
-
- if ((snpoutfilename != NULL) && (strcmp(snpoutfilename, "NULL") == 0)) return ;
- if (snpoutfilename != NULL) {
- openit(snpoutfilename, &xfile, "w") ;
- }
- else xfile = stdout ;
-
- if( tersemode == NO) {
- fprintf(xfile,"\n");
- fprintf(xfile,"###DETAILS ABOUT THE MARKERS\n");
- fprintf(xfile,"##Gen_Pos: genetic position, Phys_pos: Physical position\n");
- fprintf(xfile,"##Afr_vart: Parental African variant allele count, Afr_ref: Parental African reference allele count\n");
- fprintf(xfile,"##Eur_vart: Parental European variant allele count, Eur:ref:Parental European reference allele count\n");
-
- fprintf(xfile, "\n") ;
- fprintf(xfile,"%20s %5s %10s %18s", "#SNP_Id","Chr_Num","Gen_Pos","Phys_Pos") ;
- fprintf(xfile, " %9s %9s %9s %9s" ,"Afr_vart","Afr_ref","Eur_vart","Eur_ref");
- fprintf(xfile, "\n") ;
- }
- for (i = 0; i <num; ++i) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (!printfake && (ignoresnp(cupt))) continue ;
- if (!printfake && (cupt -> isrfake)) continue ;
- }
-
- ppos = cupt -> physpos ;
-
- mkchrom(ss, cupt -> chrom, &ppos, cupt -> chimpfudge, chrmode) ;
- fprintf(xfile, "%20s %5s ", cupt->ID, ss) ;
-
- if (cupt -> genpos == 0.0) {
- fprintf(xfile, "%15.0f %15.0f", cupt -> genpos, ppos) ;
- }
- else {
- fprintf(xfile, "%15.6f %15.0f", cupt -> genpos, ppos) ;
- }
-
- if (tersemode) {
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- continue ;
- }
-
- fprintf(xfile, " %8d ", cupt -> af_nn[0]) ;
- fprintf(xfile, "%8d ", cupt -> af_nn[1]) ;
- fprintf(xfile, "%8d ", cupt -> cauc_nn[0]) ;
- fprintf(xfile, "%8d", cupt -> cauc_nn[1]) ;
- if (!printvalids) {
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- continue ;
- }
- numvcase = numvalidgtx(indm, cupt, 1) ;
- numvcontrol = numvalidgtx(indm, cupt, 0) ;
- fprintf(xfile, " %6d %6d",numvcase, numvcontrol) ;
- fprintf(xfile, " %d %d %d", cupt -> ignore, cupt -> isfake, cupt -> isrfake) ;
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- }
- if (snpoutfilename != NULL)
- fclose(xfile) ;
}
+/* ---------------------------------------------------------------------------------------------------- */
+void
+printsnps (char *snpoutfilename, SNP **snpm, int num, Indiv **indm,
+ int printfake, int printvalids)
+{
+
+ int i, chrom;
+ double ppos;
+ SNP *cupt;
+ char ss[10];
+ FILE *xfile;
+ int numvcase, numvcontrol;
+ char c;
+
+ if ((snpoutfilename != NULL) && (strcmp (snpoutfilename, "NULL") == 0))
+ return;
+ if (snpoutfilename != NULL)
+ {
+ openit (snpoutfilename, &xfile, "w");
+ }
+ else
+ xfile = stdout;
+
+ if (tersemode == NO)
+ {
+ fprintf (xfile, "\n");
+ fprintf (xfile, "###DETAILS ABOUT THE MARKERS\n");
+ fprintf (xfile,
+ "##Gen_Pos: genetic position, Phys_pos: Physical position\n");
+ fprintf (
+ xfile,
+ "##Afr_vart: Parental African variant allele count, Afr_ref: Parental African reference allele count\n");
+ fprintf (
+ xfile,
+ "##Eur_vart: Parental European variant allele count, Eur:ref:Parental European reference allele count\n");
+
+ fprintf (xfile, "\n");
+ fprintf (xfile, "%20s %5s %10s %18s", "#SNP_Id", "Chr_Num", "Gen_Pos",
+ "Phys_Pos");
+ fprintf (xfile, " %9s %9s %9s %9s", "Afr_vart", "Afr_ref", "Eur_vart",
+ "Eur_ref");
+ fprintf (xfile, "\n");
+ }
+ for (i = 0; i < num; ++i)
+ {
+ cupt = snpm[i];
+ if (outputall == NO)
+ {
+ if (!printfake && (ignoresnp (cupt)))
+ continue;
+ if (!printfake && (cupt->isrfake))
+ continue;
+ }
+
+ ppos = cupt->physpos;
+
+ mkchrom (ss, cupt->chrom, &ppos, cupt->chimpfudge, chrmode);
+ fprintf (xfile, "%20s %5s ", cupt->ID, ss);
+
+ if (cupt->genpos == 0.0)
+ {
+ fprintf (xfile, "%15.0f %15.0f", cupt->genpos, ppos);
+ }
+ else
+ {
+ fprintf (xfile, "%15.6f %15.0f", cupt->genpos, ppos);
+ }
+
+ if (tersemode)
+ {
+ printalleles (cupt, xfile);
+ fprintf (xfile, "\n");
+ continue;
+ }
+
+ fprintf (xfile, " %8d ", cupt->af_nn[0]);
+ fprintf (xfile, "%8d ", cupt->af_nn[1]);
+ fprintf (xfile, "%8d ", cupt->cauc_nn[0]);
+ fprintf (xfile, "%8d", cupt->cauc_nn[1]);
+ if (!printvalids)
+ {
+ printalleles (cupt, xfile);
+ fprintf (xfile, "\n");
+ continue;
+ }
+ numvcase = numvalidgtx (indm, cupt, 1);
+ numvcontrol = numvalidgtx (indm, cupt, 0);
+ fprintf (xfile, " %6d %6d", numvcase, numvcontrol);
+ fprintf (xfile, " %d %d %d", cupt->ignore, cupt->isfake,
+ cupt->isrfake);
+ printalleles (cupt, xfile);
+ fprintf (xfile, "\n");
+ }
+ if (snpoutfilename != NULL)
+ fclose (xfile);
+}
/* ---------------------------------------------------------------------------------------------------- */
-void printalleles(SNP *cupt, FILE *fff) {
- char c ;
- if ((c = cupt -> alleles[0]) != CNULL) fprintf(fff, " %c", c) ;
- if ((c = cupt -> alleles[1]) != CNULL) fprintf(fff, " %c", c) ;
+void
+printalleles (SNP *cupt, FILE *fff)
+{
+ char c;
+ if ((c = cupt->alleles[0]) != CNULL)
+ fprintf (fff, " %c", c);
+ if ((c = cupt->alleles[1]) != CNULL)
+ fprintf (fff, " %c", c);
}
/* ---------------------------------------------------------------------------------------------------- */
-void printdata(char *genooutfilename, char *indoutfilename,
- SNP **snpm, Indiv **indiv, int numsnps, int numind, int packem) {
+void
+printdata (char *genooutfilename, char *indoutfilename, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind, int packem)
+{
FILE *gfile, *ifile;
- int i,j, t;
+ int i, j, t;
SNP *cupt;
Indiv *indx;
char ss[MAXSTR];
- char *gfilename ;
- int dogenos = YES ;
-
- if (packem)
- printf("packedancestrymap output\n") ;
- else
- printf("ancestrymap output\n") ;
-
- if ((genooutfilename != NULL) && (strcmp(genooutfilename, "NULL") == 0)) dogenos = NO ;
- if (genooutfilename == NULL) dogenos = NO ;
-
- if (dogenos) {
- gfilename = genooutfilename ;
- if (packem) {
- outpack(genooutfilename, snpm, indiv, numsnps, numind) ;
- gfilename = NULL ;
- }
+ char *gfilename;
+ int dogenos = YES;
+
+ if (packem)
+ printf ("packedancestrymap output\n");
+ else
+ printf ("ancestrymap output\n");
+
+ if ((genooutfilename != NULL) && (strcmp (genooutfilename, "NULL") == 0))
+ dogenos = NO;
+ if (genooutfilename == NULL)
+ dogenos = NO;
+
+ if (dogenos)
+ {
+ gfilename = genooutfilename;
+ if (packem)
+ {
+ outpack (genooutfilename, snpm, indiv, numsnps, numind);
+ gfilename = NULL;
+ }
- // print unpacked genotype output
- if (gfilename != NULL) {
- openit(gfilename, &gfile, "w") ;
- if(tersemode == NO) fprintf(gfile,"#SNP_ID,INDIV_ID,VART_ALLELE_CNT\n");
- }
+ // print unpacked genotype output
+ if (gfilename != NULL)
+ {
+ openit (gfilename, &gfile, "w");
+ if (tersemode == NO)
+ fprintf (gfile, "#SNP_ID,INDIV_ID,VART_ALLELE_CNT\n");
+ }
- for (i = 0; i< numsnps; i++) {
- if (gfilename == NULL) break ;
- cupt= snpm[i];
+ for (i = 0; i < numsnps; i++)
+ {
+ if (gfilename == NULL)
+ break;
+ cupt = snpm[i];
+
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+
+ for (j = 0; j < cupt->ngtypes; j++)
+ {
+ indx = indiv[j];
+ if (indx->ignore)
+ continue;
+ fprintf (gfile, "%20s %20s %3d\n", cupt->ID, indx->ID,
+ getgtypes (cupt, j));
+ }
+ }
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
+ if (gfilename != NULL)
+ fclose (gfile);
- for(j=0; j < cupt->ngtypes; j++) {
- indx = indiv[j];
- if (indx -> ignore) continue ;
- fprintf(gfile,"%20s %20s %3d\n",cupt->ID,indx->ID, getgtypes(cupt,j)) ;
- }
}
-
- if(gfilename != NULL)
- fclose(gfile);
- }
-
- if(indoutfilename == NULL)
+ if (indoutfilename == NULL)
return;
- if ((indoutfilename != NULL) && (strcmp(indoutfilename, "NULL") == 0)) return ;
- if (indoutfilename != NULL)
- openit(indoutfilename, &ifile, "w") ;
+ if ((indoutfilename != NULL) && (strcmp (indoutfilename, "NULL") == 0))
+ return;
+ if (indoutfilename != NULL)
+ openit (indoutfilename, &ifile, "w");
/* fprintf(ifile,"#INDIV,GENDER,POPULATION\n"); */
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- strcpy(ss, indx -> egroup) ;
- if ((qtmode) && (!indx->ignore)) {
- sprintf(ss, "%9.3f", indx -> rawqval) ;
- }
- if (tersemode) {
- fprintf(ifile,"%20s %c %10s",indx->ID, indx->gender,ss);
- fprintf(ifile,"\n") ;
- continue ;
- }
- t = numvalids(indx, snpm, 0, numsnps-1) ;
- fprintf(ifile,"%20s %c %10s %5d\n",indx->ID, indx->gender,ss, t);
- }
-
- if(indoutfilename != NULL)
- fclose(ifile);
-}
-
-
+ for (i = 0; i < numind; i++)
+ {
+ indx = indiv[i];
+ if (indx->ignore)
+ continue;
+ strcpy (ss, indx->egroup);
+ if ((qtmode) && (!indx->ignore))
+ {
+ sprintf (ss, "%9.3f", indx->rawqval);
+ }
+ if (tersemode)
+ {
+ fprintf (ifile, "%20s %c %10s", indx->ID, indx->gender, ss);
+ fprintf (ifile, "\n");
+ continue;
+ }
+ t = numvalids (indx, snpm, 0, numsnps - 1);
+ fprintf (ifile, "%20s %c %10s %5d\n", indx->ID, indx->gender, ss, t);
+ }
+ if (indoutfilename != NULL)
+ fclose (ifile);
+}
/* ---------------------------------------------------------------------------------------------------- */
-int readindval(Indiv **indivmarkers, int numindivs, char *inddataname) {
-
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
-
- FILE *fff ;
- openit(inddataname, &fff, "r") ;
- for (k=0; k <numindivs; ++k) {
- indx = indivmarkers[k] ;
- indx -> affstatus = NO ;
- indx -> qval = -999.0 ;
- }
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit < 2) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (strcmp(sx, "Indiv_Index") == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readindval) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
- indx -> qval = atof(spt[1]) ;
- indx -> affstatus = YES ;
- freeup(spt, nsplit) ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
+int
+readindval (Indiv **indivmarkers, int numindivs, char *inddataname)
+{
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k, ind;
+ int skipit;
+ Indiv *indx;
+ double y;
+ double gg[3];
+
+ FILE *fff;
+ openit (inddataname, &fff, "r");
+ for (k = 0; k < numindivs; ++k)
+ {
+ indx = indivmarkers[k];
+ indx->affstatus = NO;
+ indx->qval = -999.0;
+ }
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit < 2)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (strcmp (sx, "Indiv_Index") == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ ind = indindex (indivmarkers, numindivs, sx);
+ if (ind < 0)
+ fatalx ("(readindval) indiv: %s not found \n", sx);
+ indx = indivmarkers[ind];
+ indx->qval = atof (spt[1]);
+ indx->affstatus = YES;
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int readgdata(Indiv **indivmarkers, int numindivs, char *gname)
- // only needed for logreg
- // not correct for X chromosome
- // Needs correction for males
-{
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
-
- FILE *fff ;
-
- cleartg(indivmarkers, numindivs) ;
- openit(gname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("%s bad line: %s", gname, line) ;
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readgdata) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
- for (k=0; k<3; k++) {
- gg[k] = atof(spt[k+1]) ;
- }
- y = asum(gg, 3) ;
- vst(gg, gg, 1.0/y, 3) ;
- y = 0.5*(gg[1]+2.0*gg[2]) ; /* est caucasian ancestry */
- indx -> thetatrue = y ;
- copyarr(gg, indx -> totgamms, 3) ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
+int
+readgdata (Indiv **indivmarkers, int numindivs, char *gname)
+// only needed for logreg
+// not correct for X chromosome
+// Needs correction for males
+{
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k, ind;
+ int skipit;
+ Indiv *indx;
+ double y;
+ double gg[3];
+
+ FILE *fff;
+
+ cleartg (indivmarkers, numindivs);
+ openit (gname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = NO;
+ skipit = setskipit (sx);
+ if (skipit == NO)
+ {
+ if (nsplit < 4)
+ fatalx ("%s bad line: %s", gname, line);
+ ind = indindex (indivmarkers, numindivs, sx);
+ if (ind < 0)
+ fatalx ("(readgdata) indiv: %s not found \n", sx);
+ indx = indivmarkers[ind];
+ for (k = 0; k < 3; k++)
+ {
+ gg[k] = atof (spt[k + 1]);
+ }
+ y = asum (gg, 3);
+ vst (gg, gg, 1.0 / y, 3);
+ y = 0.5 * (gg[1] + 2.0 * gg[2]); /* est caucasian ancestry */
+ indx->thetatrue = y;
+ copyarr (gg, indx->totgamms, 3);
+ }
+ freeup (spt, nsplit);
+ continue;
+ }
+ fclose (fff);
+ return num;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int putweights(char *fname, SNP **snpm, int numsnps) {
- int num=0, k ;
- SNP *cupt ;
- double weight ;
-
- FILE *fff ;
- openit(fname, &fff, "w") ;
-
- for (k=0; k<numsnps; ++k) {
- cupt = snpm[k] ;
- if (cupt -> ignore) continue ;
- fprintf(fff, "%20s ", cupt -> ID) ;
- fprintf(fff, "%15.9f ", cupt -> weight) ;
- fprintf(fff, "\n") ;
- ++num ;
- }
- fclose(fff) ;
- return num ;
+int
+putweights (char *fname, SNP **snpm, int numsnps)
+{
+ int num = 0, k;
+ SNP *cupt;
+ double weight;
+
+ FILE *fff;
+ openit (fname, &fff, "w");
+
+ for (k = 0; k < numsnps; ++k)
+ {
+ cupt = snpm[k];
+ if (cupt->ignore)
+ continue;
+ fprintf (fff, "%20s ", cupt->ID);
+ fprintf (fff, "%15.9f ", cupt->weight);
+ fprintf (fff, "\n");
+ ++num;
+ }
+ fclose (fff);
+ return num;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int getweights(char *fname, SNP **snpm, int numsnps) {
+int
+getweights (char *fname, SNP **snpm, int numsnps)
+{
// number of real lines
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0 ;
- int skipit, k ;
- double weight ;
-
- FILE *fff ;
- for (k=0; k<numsnps; ++k) {
- snpm[k] -> weight = 1.0 ;
- }
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) {
- continue ;
- }
- sx = spt[0] ;
- skipit = NO ;
- skipit = setskipit(sx) ;
- k = snpindex(snpm, numsnps, sx) ;
- if (k<0) skipit = YES ;
- if (skipit == NO) {
- if (nsplit >1) {
- sx = spt[1] ;
- weight = atof(sx) ;
- snpm[k] -> weight = weight ;
- printf("weight set: %20s %9.3f\n", snpm[k] -> ID, weight) ;
- ++num ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- fflush(stdout) ;
- return num ;
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0;
+ int skipit, k;
+ double weight;
+
+ FILE *fff;
+ for (k = 0; k < numsnps; ++k)
+ {
+ snpm[k]->weight = 1.0;
+ }
+ openit (fname, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ {
+ continue;
+ }
+ sx = spt[0];
+ skipit = NO;
+ skipit = setskipit (sx);
+ k = snpindex (snpm, numsnps, sx);
+ if (k < 0)
+ skipit = YES;
+ if (skipit == NO)
+ {
+ if (nsplit > 1)
+ {
+ sx = spt[1];
+ weight = atof (sx);
+ snpm[k]->weight = weight;
+ printf ("weight set: %20s %9.3f\n", snpm[k]->ID, weight);
+ ++num;
+ }
+ }
+ freeup (spt, nsplit);
+ continue;
+ }
+ fclose (fff);
+ fflush (stdout);
+ return num;
}
/* ---------------------------------------------------------------------------------------------------- */
-void outpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
- char **arrx ;
- int n, num, ihash, shash, i, g, j, k ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt ;
- double y ;
- unsigned char *buff ;
- int fdes, ret ;
- char *packit ;
-
- n = numind ;
- ZALLOC(arrx, n, char *) ;
-
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- if ((outputall == NO ) && indx -> ignore) continue ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
+void
+outpack (char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps,
+ int numind)
+{
+ char **arrx;
+ int n, num, ihash, shash, i, g, j, k;
+ int nind, nsnp, irec;
+ Indiv *indx;
+ SNP *cupt;
+ double y;
+ unsigned char *buff;
+ int fdes, ret;
+ char *packit;
+
+ n = numind;
+ ZALLOC(arrx, n, char *);
+
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ indx = indiv[i];
+ if ((outputall == NO) && indx->ignore)
+ continue;
+ arrx[num] = strdup (indx->ID);
+ ++num;
+ }
// compute hash on individuals
- ihash = hasharr(arrx, num) ;
- nind= num ;
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- arrx[num] = strdup(cupt -> ID) ;
- ++num ;
- }
+ ihash = hasharr (arrx, num);
+ nind = num;
+ freeup (arrx, num);
+ free (arrx);
+
+ n = numsnps;
+ ZALLOC(arrx, n, char *);
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ cupt = snpm[i];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ arrx[num] = strdup (cupt->ID);
+ ++num;
+ }
// compute hash on SNPs
- shash = hasharr(arrx, num) ;
- nsnp = num ;
- freeup(arrx, num) ;
- free(arrx) ;
+ shash = hasharr (arrx, num);
+ nsnp = num;
+ freeup (arrx, num);
+ free (arrx);
// printf("ihash: %x shash: %x\n", ihash, shash) ;
-
+
// rlen is number of bytes each SNP will occupy in packed format
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
+ y = (double) (nind * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
// printf("nind: %d rlen: %d\n", nind, rlen) ;
- ZALLOC(buff, rlen, unsigned char) ;
- sprintf((char *) buff,"GENO %7d %7d %x %x", nind, nsnp, ihash, shash) ;
-
- ridfile(genooutfilename) ;
- fdes = open(genooutfilename, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad genoout") ;
- fatalx("open failed for %s\n", genooutfilename) ;
- }
- if (verbose)
- printf("file %s opened\n", genooutfilename) ;
-
- ret = write(fdes, buff, rlen) ;
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
-
- irec = 1;
- for (i=0; i<numsnps ; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- cclear((unsigned char *) buff, 0X00, rlen) ;
- num = 0 ;
- for (j=0; j< numind; j++) {
- indx = indiv[j] ;
- if (indx -> ignore) continue ;
- g = getgtypes(cupt, j) ;
- if (g<0) g=3 ;
- wbuff( buff, num, g) ; // store two-bit genotype in packed data buffer
- ++num ;
- }
- ret = write(fdes, buff, rlen) ; // print out all SNPs in packed data buffer
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- if (verbose) {
- printf("record: %4d ", irec) ;
- for (k=0; k<rlen; ++k) {
- printf(" %02x", (unsigned char) buff[k]) ;
- }
- printf("\n") ;
- }
- ++irec ;
- }
- close(fdes) ;
- free(buff) ;
- // printf("check: %s %d\n", genooutfilename, ispack(genooutfilename)) ;
-}
+ ZALLOC(buff, rlen, unsigned char);
+ sprintf ((char *) buff, "GENO %7d %7d %x %x", nind, nsnp, ihash, shash);
+
+ ridfile (genooutfilename);
+ fdes = open (genooutfilename, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ if (fdes < 0)
+ {
+ perror ("bad genoout");
+ fatalx ("open failed for %s\n", genooutfilename);
+ }
+ if (verbose)
+ printf ("file %s opened\n", genooutfilename);
+
+ ret = write (fdes, buff, rlen);
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ irec = 1;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ cclear ((unsigned char *) buff, 0X00, rlen);
+ num = 0;
+ for (j = 0; j < numind; j++)
+ {
+ indx = indiv[j];
+ if (indx->ignore)
+ continue;
+ g = getgtypes (cupt, j);
+ if (g < 0)
+ g = 3;
+ wbuff (buff, num, g); // store two-bit genotype in packed data buffer
+ ++num;
+ }
+ ret = write (fdes, buff, rlen); // print out all SNPs in packed data buffer
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ if (verbose)
+ {
+ printf ("record: %4d ", irec);
+ for (k = 0; k < rlen; ++k)
+ {
+ printf (" %02x", (unsigned char) buff[k]);
+ }
+ printf ("\n");
+ }
+ ++irec;
+ }
+ close (fdes);
+ free (buff);
+ // printf("check: %s %d\n", genooutfilename, ispack(genooutfilename)) ;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int ispack(char *gname) {
+int
+ispack (char *gname)
+{
// checks if file is packed gfile
- int fdes, t, ret ;
- char buff[8] ;
-
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(ispack) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, 8 ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(ispack) bad read") ;
- }
- close(fdes) ;
- buff[4] = '\0' ;
- ret = strcmp(buff, "GENO") ;
- if (ret == 0) return YES ;
- return NO ;
-
+ int fdes, t, ret;
+ char buff[8];
+
+ fdes = open (gname, O_RDONLY);
+ if (fdes < 0)
+ {
+ perror ("open failure");
+ fatalx ("(ispack) bad open %s\n", gname);
+ }
+ t = read (fdes, buff, 8);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(ispack) bad read");
+ }
+ close (fdes);
+ buff[4] = '\0';
+ ret = strcmp (buff, "GENO");
+ if (ret == 0)
+ return YES;
+ return NO;
+
}
+/* ---------------------------------------------------------------------------------------------------- */
+int
+iseigenstrat (char *gname)
+{
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k;
+
+ openit (gname, &fff, "r");
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ freeup (spt, nsplit);
+ fclose (fff);
+ if (nsplit > 1)
+ return NO;
+ return YES;
+ }
+ fatalx ("(iseigenstrat) no genotyped data found\n");
-/* ---------------------------------------------------------------------------------------------------- */
-int iseigenstrat(char *gname) {
+}
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
+/* ---------------------------------------------------------------------------------------------------- */
+int
+ineigenstrat (char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
+{
+ // supports enhanced format fist character X => all missing data for SNP
+ FILE *fff;
+ char *line = NULL, c;
+ char *spt[2], *sx;
+ int nsplit, rownum = 0, k, num;
+ int maxstr, maxff = 2;
+ int nind, nsnp, len;
+ double y;
+ unsigned char *buff;
+ char *packit, *pbuff;
+ int g, g1, g2;
+ SNP *cupt;
+ Indiv *indx;
+ int nbad = 0;
+ packmode = YES;
+ maxstr = numind + 10;
+ ZALLOC(line, maxstr, char);
- openit(gname, &fff, "r") ;
+ nind = numind;
+ nsnp = numsnps;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit ==0 ) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
+ // rlen is number of bytes used to store each SNP's genotype data
+ y = (double) (nind * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
+ ZALLOC(buff, rlen, unsigned char);
+
+ packlen = rlen * nsnp;
+ if (packgenos == NULL)
+ {
+ ZALLOC(packgenos, packlen, char);
+ clearepath (packgenos);
}
- freeup(spt, nsplit) ;
- fclose(fff) ;
- if (nsplit>1) return NO ;
- return YES ;
- }
- fatalx("(iseigenstrat) no genotyped data found\n") ;
-}
+ openit (gname, &fff, "r");
+
+ rownum = 0;
+ pbuff = packgenos;
+ while (fgets (line, maxstr, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ continue;
+
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit > 1)
+ fatalx ("(ineigenstrat) more than 1 field\n"); // white space not expected
+
+ if (rownum >= numsnps)
+ fatalx ("(ineigenstrat) too many lines in file %d %d\n", rownum,
+ numsnps);
+ num = snpord[rownum];
+ cupt = snpm[num];
+ ++rownum;
+ if (cupt == NULL)
+ continue;
+
+ if (cupt->ngtypes == 0)
+ {
+ if (packmode == NO)
+ {
+ ZALLOC(cupt -> gtypes, numind, int);
+ ivclear (cupt->gtypes, -1, numind);
+ }
+ else
+ {
+ ZALLOC(cupt -> gtypes, 1, int);
+ cupt->pbuff = pbuff;
+ pbuff += rlen;
+ }
+ cupt->ngtypes = numind;
+ }
+ if (sx[0] == 'X')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
-/* ---------------------------------------------------------------------------------------------------- */
-int ineigenstrat(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
- // supports enhanced format fist character X => all missing data for SNP
- FILE *fff ;
- char *line = NULL, c ;
- char *spt[2], *sx ;
- int nsplit, rownum=0, k, num ;
- int maxstr, maxff = 2 ;
- int nind, nsnp, len ;
- double y ;
- unsigned char *buff ;
- char *packit, *pbuff ;
- int g, g1, g2 ;
- SNP *cupt ;
- Indiv *indx ;
- int nbad=0 ;
-
-
- packmode = YES ;
- maxstr = numind+10 ;
- ZALLOC(line, maxstr, char) ;
-
- nind = numind ;
- nsnp = numsnps ;
+ len = strlen (sx);
+ if (len != nind)
+ {
+ printf ("(ineigenstrat) bad line %d ::%s\n", rownum, line);
+ fatalx ("(ineigenstrat) mismatch line length %d %d\n", len, nind);
+ }
- // rlen is number of bytes used to store each SNP's genotype data
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
-
- packlen = rlen*nsnp ;
- if (packgenos==NULL) {
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
- }
-
- openit(gname, &fff, "r") ;
-
- rownum = 0 ;
- pbuff = packgenos ;
- while (fgets(line, maxstr, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit ==0 ) continue ;
-
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- if (nsplit>1) fatalx("(ineigenstrat) more than 1 field\n") ; // white space not expected
-
- if (rownum>=numsnps) fatalx("(ineigenstrat) too many lines in file %d %d\n", rownum, numsnps) ;
- num = snpord[rownum] ;
- cupt = snpm[num] ;
- ++rownum ;
- if (cupt == NULL) continue ;
-
- if (cupt -> ngtypes == 0) {
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numind, int) ;
- ivclear(cupt -> gtypes, -1, numind) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numind ;
- }
-
- if (sx[0] == 'X') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- len = strlen(sx) ;
- if (len != nind) {
- printf("(ineigenstrat) bad line %d ::%s\n", rownum, line) ;
- fatalx("(ineigenstrat) mismatch line length %d %d\n", len, nind) ;
- }
-
- for (k=0; k<len; k++) {
- sscanf(sx+k, "%c", &c) ;
- g = -2 ;
- if (c=='0') g = 0 ;
- if (c=='1') g = 1 ;
- if (c=='2') g = 2 ;
- if (c=='9') g = -1 ;
-
- if (g==-2) fatalx("(ineigenstrat) bad character %c\n", c) ;
- if (indiv[k] -> ignore) g = -1 ;
- if (checkxval(cupt, indiv[k], g) == NO) g = -1 ;
-
- indx = indiv[k] ;
- if (checkxval(cupt, indx, g) == NO) g = -1 ;
- g2 = g ;
- if (g2<0) continue ;
- g1 = getgtypes(cupt, k) ;
- if ( (g1>=0) && (g1 != g2)) ++nbad ; // something is already stored there
- putgtypes(cupt, k, g2) ;
- }
- freeup(spt, nsplit) ;
- }
- if (rownum != numsnps) fatalx("(ineigenstrat) mismatch in numsnps %d and numlines %d\n", numsnps, rownum) ;
- fclose(fff) ;
- freestring(&line) ;
-
- return nbad ;
+ for (k = 0; k < len; k++)
+ {
+ sscanf (sx + k, "%c", &c);
+ g = -2;
+ if (c == '0')
+ g = 0;
+ if (c == '1')
+ g = 1;
+ if (c == '2')
+ g = 2;
+ if (c == '9')
+ g = -1;
+
+ if (g == -2)
+ fatalx ("(ineigenstrat) bad character %c\n", c);
+ if (indiv[k]->ignore)
+ g = -1;
+ if (checkxval (cupt, indiv[k], g) == NO)
+ g = -1;
+
+ indx = indiv[k];
+ if (checkxval (cupt, indx, g) == NO)
+ g = -1;
+ g2 = g;
+ if (g2 < 0)
+ continue;
+ g1 = getgtypes (cupt, k);
+ if ((g1 >= 0) && (g1 != g2))
+ ++nbad; // something is already stored there
+ putgtypes (cupt, k, g2);
+ }
+ freeup (spt, nsplit);
+ }
+ if (rownum != numsnps)
+ fatalx ("(ineigenstrat) mismatch in numsnps %d and numlines %d\n", numsnps,
+ rownum);
+ fclose (fff);
+ freestring (&line);
+
+ return nbad;
}
/* ---------------------------------------------------------------------------------------------------- */
-int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash) {
- char **arrx ;
- int ihash, shash, n, num ;
- int i ;
- Indiv *indx ;
- SNP *cupt ;
-
- n = numind ;
- ZALLOC(arrx, n, char *) ;
-
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
- *pihash = hasharr(arrx, num) ;
-
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- arrx[num] = strdup(cupt -> ID) ;
- cupt -> ngtypes = numind ;
- ++num ;
- }
- *pshash = hasharr(arrx, num) ;
- freeup(arrx, num) ;
- free(arrx) ;
- return num ;
+int
+calcishash (SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash,
+ int *pshash)
+{
+ char **arrx;
+ int ihash, shash, n, num;
+ int i;
+ Indiv *indx;
+ SNP *cupt;
-}
+ n = numind;
+ ZALLOC(arrx, n, char *);
+
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ indx = indiv[i];
+ arrx[num] = strdup (indx->ID);
+ ++num;
+ }
+ *pihash = hasharr (arrx, num);
+
+ freeup (arrx, num);
+ free (arrx);
+
+ n = numsnps;
+ ZALLOC(arrx, n, char *);
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->isfake)
+ continue;
+ arrx[num] = strdup (cupt->ID);
+ cupt->ngtypes = numind;
+ ++num;
+ }
+ *pshash = hasharr (arrx, num);
+ freeup (arrx, num);
+ free (arrx);
+ return num;
+}
-long bigread(int fdes, char *packg, long numbytes)
+long
+bigread (int fdes, char *packg, long numbytes)
{
- long x ;
- int xx ;
- char *pt ;
- long nb, t, nr=0 ;
- int pswitch = NO ;
-
-
- pt = packg ;
-
- x = nnint(pow(2, 30)) ;
-
- nb = numbytes ;
- if (nb>x) pswitch = YES ;
-
- for (;;) {
- xx = MIN(x, nb) ;
- t = read(fdes, pt, xx ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(bigread) bad data read") ;
- }
- if (t != xx) {
- perror("read failure (length mismatch)") ;
- fatalx("(bigread) bad data read (length mismatch) %ld %ld\n", t, xx) ;
- }
- nb -= xx ;
- nr += xx ;
- if (pswitch) printf("read %ld bytes\n", nr) ;
- if (nb==0) break ;
- pt += xx ;
- }
- return nr ;
+ long x;
+ int xx;
+ char *pt;
+ long nb, t, nr = 0;
+ int pswitch = NO;
+
+ pt = packg;
+
+ x = nnint (pow (2, 30));
+
+ nb = numbytes;
+ if (nb > x)
+ pswitch = YES;
+
+ for (;;)
+ {
+ xx = MIN(x, nb);
+ t = read (fdes, pt, xx);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(bigread) bad data read");
+ }
+ if (t != xx)
+ {
+ perror ("read failure (length mismatch)");
+ fatalx ("(bigread) bad data read (length mismatch) %ld %ld\n", t, xx);
+ }
+ nb -= xx;
+ nr += xx;
+ if (pswitch)
+ printf ("read %ld bytes\n", nr);
+ if (nb == 0)
+ break;
+ pt += xx;
+ }
+ return nr;
}
-int getsnpordered()
+int
+getsnpordered ()
{
- return snpordered ;
+ return snpordered;
}
-void putsnpordered(int mode)
+void
+putsnpordered (int mode)
{
- snpordered = mode ;
+ snpordered = mode;
}
-void setpordercheck (int mode)
+void
+setpordercheck (int mode)
{
- pordercheck = mode ;
+ pordercheck = mode;
}
-void failorder()
+void
+failorder ()
{
- fatalx("snps out of order and packed format. Run convertf with pordercheck: NO\n") ;
+ fatalx (
+ "snps out of order and packed format. Run convertf with pordercheck: NO\n");
}
/* ---------------------------------------------------------------------------------------------------- */
-void inpack(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
-
- char **arrx, junk[10] ;
- int n, num, ihash, shash, i, g, j, k ;
- long t ;
- int xihash, xshash, xnsnp, xnind ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt ;
- double y ;
- unsigned char *buff ;
- int fdes, ret ;
- char *packit, *pbuff ;
-
- nind = n = numind ;
- nsnp = calcishash(snpm, indiv, numsnps, numind, &ihash, &shash) ;
+void
+inpack (char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
+{
+
+ char **arrx, junk[10];
+ int n, num, ihash, shash, i, g, j, k;
+ long t;
+ int xihash, xshash, xnsnp, xnind;
+ int nind, nsnp, irec;
+ Indiv *indx;
+ SNP *cupt;
+ double y;
+ unsigned char *buff;
+ int fdes, ret;
+ char *packit, *pbuff;
+
+ nind = n = numind;
+ nsnp = calcishash (snpm, indiv, numsnps, numind, &ihash, &shash);
// rlen is the number of bytes needed to store one SNP's genotype data
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
+ y = (double) (nind * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
+ ZALLOC(buff, rlen, unsigned char);
// open binary file and check readability
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(ispack) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, rlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack) bad read") ;
- }
-
- if (pordercheck && (snpordered == NO)) failorder() ;
+ fdes = open (gname, O_RDONLY);
+ if (fdes < 0)
+ {
+ perror ("open failure");
+ fatalx ("(ispack) bad open %s\n", gname);
+ }
+ t = read (fdes, buff, rlen);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(inpack) bad read");
+ }
+
+ if (pordercheck && (snpordered == NO))
+ failorder ();
// check for file modification
- if (hashcheck) {
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
- if (xnind != nind) fatalx("OOPS number of individuals %d != %d in input files\n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp, gname) ;
- if (xihash != ihash) fatalx("OOPS indiv file has changed since genotype file was created\n") ;
- if (xshash != shash) fatalx("OOPS snp file has changed since genotype file was created\n") ;
- }
-
- packlen = rlen*nsnp ;
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
+ if (hashcheck)
+ {
+ sscanf ((char *) buff, "GENO %d %d %x %x", &xnind, &xnsnp, &xihash,
+ &xshash);
+ if (xnind != nind)
+ fatalx ("OOPS number of individuals %d != %d in input files\n", nind,
+ xnind);
+ if (xnsnp != nsnp)
+ fatalx ("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp,
+ gname);
+ if (xihash != ihash)
+ fatalx (
+ "OOPS indiv file has changed since genotype file was created\n");
+ if (xshash != shash)
+ fatalx ("OOPS snp file has changed since genotype file was created\n");
+ }
+
+ packlen = rlen * nsnp;
+ ZALLOC(packgenos, packlen, char);
+ clearepath (packgenos);
// printf("packgenos: %x end: %x len: %d\n", packgenos, packgenos+packlen-1, packlen) ;
- t = bigread(fdes, packgenos, packlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack) bad data read") ;
- }
- if (t != packlen) {
- perror("read failure (length mismatch)") ;
- printf("numsnps: %d nsnp (from geno file): %d\n", numsnps, nsnp) ;
- fatalx("(inpack) bad data read (length mismatch) %ld %ld\n", t, packlen) ;
- }
- else printf("packed geno read OK\n") ;
+ t = bigread (fdes, packgenos, packlen);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(inpack) bad data read");
+ }
+ if (t != packlen)
+ {
+ perror ("read failure (length mismatch)");
+ printf ("numsnps: %d nsnp (from geno file): %d\n", numsnps, nsnp);
+ fatalx ("(inpack) bad data read (length mismatch) %ld %ld\n", t, packlen);
+ }
+ else
+ printf ("packed geno read OK\n");
// now set up pointers into packed data
- pbuff = packgenos ;
- for (i=0; i<numsnps ; i++) {
- j = snpord[i] ;
- if (snpordered == YES) j = i ;
- if (j<0) fatalx("(inpack) bug\n") ;
- if (j>nsnp) fatalx("(inpack) bug\n") ;
- cupt = snpm[j] ;
- if (cupt -> isfake) continue ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- // now check xhets
- for (k=0; k<numind; ++k) {
- indx = indiv[k] ;
- g = getgtypes(cupt, k) ;
- if (checkxval(cupt, indx, g) == NO) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-
- free(buff) ;
- close(fdes) ;
-}
+ pbuff = packgenos;
+ for (i = 0; i < numsnps; i++)
+ {
+ j = snpord[i];
+ if (snpordered == YES)
+ j = i;
+ if (j < 0)
+ fatalx ("(inpack) bug\n");
+ if (j > nsnp)
+ fatalx ("(inpack) bug\n");
+ cupt = snpm[j];
+ if (cupt->isfake)
+ continue;
+ cupt->pbuff = pbuff;
+ pbuff += rlen;
+ // now check xhets
+ for (k = 0; k < numind; ++k)
+ {
+ indx = indiv[k];
+ g = getgtypes (cupt, k);
+ if (checkxval (cupt, indx, g) == NO)
+ {
+ putgtypes (cupt, k, -1);
+ }
+ }
+ }
+ free (buff);
+ close (fdes);
+}
/* ---------------------------------------------------------------------------------------------------- */
-void getsnpsc(char *snpscname, SNP **snpm, int numsnps) {
-
- FILE *fff ;
- int score ;
- SNP *cupt ;
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- double y ;
-
-
- if (snpscname == NULL) fatalx("no snpsc file\n") ;
- else openit(snpscname, &fff, "r") ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit ==0 ) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- k = snpindex(snpm, numsnps, sx) ;
- if (k<0) {
- printf("*** warning. snp %s in snpscname but not in main snp file\n", spt[0]) ;
- freeup(spt, nsplit) ;
- continue ;
- }
- y = atof(spt[1]) ;
- y += .1 * gauss() ; // dither
- cupt = snpm[k] ;
- cupt -> score = y ;
- freeup(spt, nsplit) ;
- }
-
- if (snpscname != NULL) fclose(fff) ;
+void
+getsnpsc (char *snpscname, SNP **snpm, int numsnps)
+{
+
+ FILE *fff;
+ int score;
+ SNP *cupt;
+ char line[MAXSTR];
+ char *spt[MAXFF], *sx;
+ int nsplit, num = 0, k;
+ double y;
+
+ if (snpscname == NULL)
+ fatalx ("no snpsc file\n");
+ else
+ openit (snpscname, &fff, "r");
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ k = snpindex (snpm, numsnps, sx);
+ if (k < 0)
+ {
+ printf (
+ "*** warning. snp %s in snpscname but not in main snp file\n",
+ spt[0]);
+ freeup (spt, nsplit);
+ continue;
+ }
+ y = atof (spt[1]);
+ y += .1 * gauss (); // dither
+ cupt = snpm[k];
+ cupt->score = y;
+ freeup (spt, nsplit);
+ }
+
+ if (snpscname != NULL)
+ fclose (fff);
}
/* ---------------------------------------------------------------------------------------------------- */
-void setepath(SNP **snpm, int nsnps) {
-
- int i ;
- SNP *cupt ;
- char *pbuff ;
-
- if (packlen==0) fatalx("(setepath) packlen unset\n") ;
- ZALLOC(packepath, packlen, char) ;
- printf("setepath. packlen: %ld rlen: %ld\n", packlen, rlen) ;
- pbuff = packepath ;
- for (i=0 ; i<nsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- cupt -> ebuff = pbuff ;
- pbuff += rlen ;
- }
- clearepath(packepath) ;
-}
+void
+setepath (SNP **snpm, int nsnps)
+{
+ int i;
+ SNP *cupt;
+ char *pbuff;
+
+ if (packlen == 0)
+ fatalx ("(setepath) packlen unset\n");
+ ZALLOC(packepath, packlen, char);
+ printf ("setepath. packlen: %ld rlen: %ld\n", packlen, rlen);
+ pbuff = packepath;
+ for (i = 0; i < nsnps; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->isfake)
+ continue;
+ cupt->ebuff = pbuff;
+ pbuff += rlen;
+ }
+ clearepath (packepath);
+}
/* ---------------------------------------------------------------------------------------------------- */
-void clearepath(char *packp) {
- cclear((unsigned char *) packp, 0XFF, packlen) ;
+void
+clearepath (char *packp)
+{
+ cclear ((unsigned char *) packp, 0XFF, packlen);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int getpedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore) {
- int val ;
- int ngenos = 0 ;
-
- SNP *cupt ;
- Indiv *indx ;
-
- char *line ;
- char **spt, *sx ;
- char c ;
- int nsplit, num=0 ;
- int skipit ;
- int numf, snpnumber, nsnp ;
- int k, n, t, i ;
- FILE *fff ;
- int **gcounts, *gvar, *gref ;
- int xvar, xref ;
- int parity, colbase, ncols ;
- int snpnum ;
- int markernum = -99 ;
- int n1, n2 ;
+int
+getpedgenos (char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs, int nignore)
+{
+ int val;
+ int ngenos = 0;
+
+ SNP *cupt;
+ Indiv *indx;
+
+ char *line;
+ char **spt, *sx;
+ char c;
+ int nsplit, num = 0;
+ int skipit;
+ int numf, snpnumber, nsnp;
+ int k, n, t, i;
+ FILE *fff;
+ int **gcounts, *gvar, *gref;
+ int xvar, xref;
+ int parity, colbase, ncols;
+ int snpnum;
+ int markernum = -99;
+ int n1, n2;
/*
markernum = snpindex(snpmarkers, numsnps, "rs3002685") ;
if (markernum <0) fatalx("qq1") ;
- */
+ */
- maxgenolinelength = MAX(maxgenolinelength, maxlinelength(gname)) ;
+ maxgenolinelength = MAX(maxgenolinelength, maxlinelength (gname));
// printf("maxlinelen %d\n", maxlinelength(gname)) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
+ ZALLOC(line, maxgenolinelength+1, char);
- cleargdata(snpmarkers, numsnps, numindivs) ;
- nsnp = numsnps ;
+ cleargdata (snpmarkers, numsnps, numindivs);
+ nsnp = numsnps;
- ZALLOC(gcounts, nsnp, int *) ;
- for (i=0; i<nsnp; i++) {
- ZALLOC(gcounts[i], 5, int) ;
- }
- genopedcnt(gname, gcounts, nsnp) ;
+ ZALLOC(gcounts, nsnp, int *);
+ for (i = 0; i < nsnp; i++)
+ {
+ ZALLOC(gcounts[i], 5, int);
+ }
+ genopedcnt (gname, gcounts, nsnp);
- ZALLOC(gvar, nsnp, int) ;
- ZALLOC(gref, nsnp, int) ;
+ ZALLOC(gvar, nsnp, int);
+ ZALLOC(gref, nsnp, int);
// designate ref and var alleles from counts
- setgref(gcounts, nsnp, gvar, gref) ;
+ setgref (gcounts, nsnp, gvar, gref);
// Override improvised ref and var designations if they were in the .map file
- for (i=0; i<nsnp; ++i) {
- cupt = snpmarkers[i] ;
- if (cupt -> alleles[0] != CNULL) {
- c = cupt -> alleles[0] ;
- gvar[i] = xpedval(c) ;
- c = cupt -> alleles[1] ;
- gref[i] = xpedval(c) ;
- }
- else {
- c = x2base(gvar[i]) ;
- cupt -> alleles[0] = c ;
- c = x2base(gref[i]) ;
- cupt -> alleles[1] = c ;
+ for (i = 0; i < nsnp; ++i)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->alleles[0] != CNULL)
+ {
+ c = cupt->alleles[0];
+ gvar[i] = xpedval (c);
+ c = cupt->alleles[1];
+ gref[i] = xpedval (c);
+ }
+ else
+ {
+ c = x2base (gvar[i]);
+ cupt->alleles[0] = c;
+ c = x2base (gref[i]);
+ cupt->alleles[1] = c;
+ }
}
- }
- numf = 2*nsnp+10 ;
- ZALLOC(spt, numf, char *) ;
+ numf = 2 * nsnp + 10;
+ ZALLOC(spt, numf, char *);
// Read genotype file, one line per individual
- openit(gname, &fff, "r") ;
- while (fgets(line, maxgenolinelength, fff) != NULL) {
-
- nsplit = splitup(line, spt, numf) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- // On first individual, set column base (6 or 7)
- if (num==0) {
- parity = nsplit % 2 ;
- ncols = nsplit ;
- colbase = 6 + parity ;
- }
- if (nsplit != ncols)
- fatalx("bad number of fields %d %d\n", ncols, nsplit) ;
-
- // Loop over SNPs
- for (k=colbase ; k < nsplit-1 ; k+=2) {
- snpnumber = (k-colbase)/2 ;
-
- if (snpnumber >= numsnpord) fatalx("snpord overflow\n") ;
- snpnum = snpord[snpnumber] ;
- if (snpnum<0) fatalx("logic bug (bad snpord)\n") ;
-
- xvar = gvar[snpnum] ;
- xref = gref[snpnum] ;
-
- t = 0 ;
-
- n1 = n = pedval(spt[k]) ;
- n2 = pedval(spt[k+1]) ;
-
- if ((n1==5) || (n2==5)) { // Missing data
- val = -1 ;
- putgtypes(cupt, num, val) ;
- continue ;
- }
-
- if ((n<0) || (n>4)) fatalx("(getpedgenos) %s bad geno %s\n", gname, spt[k]) ;
- if (n==xvar) ++t ;
- if ((n != xvar) && (n != xref)) t = -10 ;
-
- n = n2 ;
- if ((n<0) || (n>4)) fatalx("(getpedgenos) %s bad geno %s\n", gname, spt[k+1]) ;
- if (n==xvar) ++t ;
- if ((n != xvar) && (n != xref)) t = -10 ;
-
- if (t<0) t = -1 ; // Any unexpected allele is stored as "missing"
- cupt = snpmarkers[snpnum] ;
- if (cupt -> ignore) continue ;
- val = t ;
- if (checkxval(cupt, indivmarkers[num], val) == NO) val = -1 ;
- putgtypes(cupt, num, val) ; // Store genotype
- if (val>=0) ++ngenos ;
-
- } // rof (SNP)
- freeup(spt, nsplit) ;
- ++num ;
-
- } // elihw (individual)
-
- free(spt) ;
- fclose(fff) ;
-
- for (i=0; i<nsnp; i++) {
- free(gcounts[i]) ;
- }
-
- free(gcounts) ;
- free(gref) ;
- free(gvar) ;
- free(line) ;
-
- printf("genotype file processed\n") ;
- return ngenos ;
+ openit (gname, &fff, "r");
+ while (fgets (line, maxgenolinelength, fff) != NULL)
+ {
+
+ nsplit = splitup (line, spt, numf);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ skipit = NO;
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+
+ // On first individual, set column base (6 or 7)
+ if (num == 0)
+ {
+ parity = nsplit % 2;
+ ncols = nsplit;
+ colbase = 6 + parity;
+ }
+ if (nsplit != ncols)
+ fatalx ("bad number of fields %d %d\n", ncols, nsplit);
+
+ // Loop over SNPs
+ for (k = colbase; k < nsplit - 1; k += 2)
+ {
+ snpnumber = (k - colbase) / 2;
+
+ if (snpnumber >= numsnpord)
+ fatalx ("snpord overflow\n");
+ snpnum = snpord[snpnumber];
+ if (snpnum < 0)
+ fatalx ("logic bug (bad snpord)\n");
+
+ xvar = gvar[snpnum];
+ xref = gref[snpnum];
+
+ t = 0;
+
+ n1 = n = pedval (spt[k]);
+ n2 = pedval (spt[k + 1]);
+
+ if ((n1 == 5) || (n2 == 5))
+ { // Missing data
+ val = -1;
+ putgtypes (cupt, num, val);
+ continue;
+ }
+
+ if ((n < 0) || (n > 4))
+ fatalx ("(getpedgenos) %s bad geno %s\n", gname, spt[k]);
+ if (n == xvar)
+ ++t;
+ if ((n != xvar) && (n != xref))
+ t = -10;
+
+ n = n2;
+ if ((n < 0) || (n > 4))
+ fatalx ("(getpedgenos) %s bad geno %s\n", gname, spt[k + 1]);
+ if (n == xvar)
+ ++t;
+ if ((n != xvar) && (n != xref))
+ t = -10;
+
+ if (t < 0)
+ t = -1; // Any unexpected allele is stored as "missing"
+ cupt = snpmarkers[snpnum];
+ if (cupt->ignore)
+ continue;
+ val = t;
+ if (checkxval (cupt, indivmarkers[num], val) == NO)
+ val = -1;
+ putgtypes (cupt, num, val); // Store genotype
+ if (val >= 0)
+ ++ngenos;
+
+ } // rof (SNP)
+ freeup (spt, nsplit);
+ ++num;
+
+ } // elihw (individual)
+
+ free (spt);
+ fclose (fff);
+
+ for (i = 0; i < nsnp; i++)
+ {
+ free (gcounts[i]);
+ }
+
+ free (gcounts);
+ free (gref);
+ free (gvar);
+ free (line);
+
+ printf ("genotype file processed\n");
+ return ngenos;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void genopedcnt(char *gname, int **gcounts, int nsnp) {
- char *line ;
- char **spt, *sx ;
- int nsplit, num=0 ;
- int skipit ;
- int numf, snpnumber, snpnum ;
- int k, n ;
- FILE *fff ;
- int parity, ncols, colbase ;
+void
+genopedcnt (char *gname, int **gcounts, int nsnp)
+{
+ char *line;
+ char **spt, *sx;
+ int nsplit, num = 0;
+ int skipit;
+ int numf, snpnumber, snpnum;
+ int k, n;
+ FILE *fff;
+ int parity, ncols, colbase;
// gcounts already zeroed
- maxgenolinelength = MAX(maxgenolinelength, maxlinelength(gname)) ;
+ maxgenolinelength = MAX(maxgenolinelength, maxlinelength (gname));
// printf("maxlinelen %d\n", maxlinelength(gname)) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
-
- numf = 2*nsnp+10 ;
- ZALLOC(spt, numf, char *) ;
-
- openit(gname, &fff, "r") ;
- while (fgets(line, maxgenolinelength, fff) != NULL) {
-
- nsplit = splitup(line, spt, numf) ;
- if (nsplit == 0) continue ;
- skipit = NO ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (num==0) {
- parity = nsplit % 2 ;
- ncols = nsplit ;
- colbase = 6 + parity ; // QUESTION: what is the optional seventh column?
- }
-
- for (k=colbase ; k < nsplit-1 ; k+=2) {
- snpnumber = (k-colbase)/2 ;
- if (snpnumber >= numsnpord) fatalx("snpord overflow\n") ;
- snpnum = snpord[snpnumber] ;
- if (snpnum<0) fatalx("logic bug (bad snpord)\n") ;
- n = pedval(spt[k]) ;
- // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k]) ;
- if ((n<0) || (n>4)) continue ;
- if (n>0) {
- ++gcounts[snpnum][n] ;
- ++num ;
- }
- n = pedval(spt[k+1]) ;
- // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k+1]) ;
- if ((n<0) || (n>4)) continue ;
- if (n>0) {
- ++gcounts[snpnum][n] ;
- ++num ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- free(spt) ;
- free(line) ;
- fclose(fff) ;
- return ;
-}
+ ZALLOC(line, maxgenolinelength+1, char);
+
+ numf = 2 * nsnp + 10;
+ ZALLOC(spt, numf, char *);
+
+ openit (gname, &fff, "r");
+ while (fgets (line, maxgenolinelength, fff) != NULL)
+ {
+
+ nsplit = splitup (line, spt, numf);
+ if (nsplit == 0)
+ continue;
+ skipit = NO;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (num == 0)
+ {
+ parity = nsplit % 2;
+ ncols = nsplit;
+ colbase = 6 + parity; // QUESTION: what is the optional seventh column?
+ }
+ for (k = colbase; k < nsplit - 1; k += 2)
+ {
+ snpnumber = (k - colbase) / 2;
+ if (snpnumber >= numsnpord)
+ fatalx ("snpord overflow\n");
+ snpnum = snpord[snpnumber];
+ if (snpnum < 0)
+ fatalx ("logic bug (bad snpord)\n");
+ n = pedval (spt[k]);
+ // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k]) ;
+ if ((n < 0) || (n > 4))
+ continue;
+ if (n > 0)
+ {
+ ++gcounts[snpnum][n];
+ ++num;
+ }
+ n = pedval (spt[k + 1]);
+ // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k+1]) ;
+ if ((n < 0) || (n > 4))
+ continue;
+ if (n > 0)
+ {
+ ++gcounts[snpnum][n];
+ ++num;
+ }
+ }
+ freeup (spt, nsplit);
+ continue;
+ }
+ free (spt);
+ free (line);
+ fclose (fff);
+ return;
+}
/* ---------------------------------------------------------------------------------------------------- */
-void outfiles(char *snpname, char *indname, char *gname, SNP **snpm,
- Indiv **indiv, int numsnps, int numindx, int packem, int ogmode) {
+void
+outfiles (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numindx, int packem, int ogmode)
+{
/* call at end of main program usually */
-
- int sizelimit = 10000000 ;
- int numind ;
+
+ int sizelimit = 10000000;
+ int numind;
// Squeeze out individuals with ignore flag set
- numind = rmindivs(snpm, numsnps, indiv, numindx) ;
- if (snpname == NULL) {
- printf("*** warning output snpname NULL\n") ;
- printf("snpname: %s %d\n", snpname, numsnps) ;
- printf("indname: %s %d\n", indname, numind) ;
- printf("gname: %s\n", gname) ;
+ numind = rmindivs (snpm, numsnps, indiv, numindx);
+ if (snpname == NULL)
+ {
+ printf ("*** warning output snpname NULL\n");
+ printf ("snpname: %s %d\n", snpname, numsnps);
+ printf ("indname: %s %d\n", indname, numind);
+ printf ("gname: %s\n", gname);
}
- switch (outputmode) {
+ switch (outputmode)
+ {
- case EIGENSTRAT:
- printf("eigenstrat output\n") ;
- outeigenstrat(snpname, indname, gname, snpm, indiv, numsnps, numind) ;
- return ;
+ case EIGENSTRAT:
+ printf ("eigenstrat output\n");
+ outeigenstrat (snpname, indname, gname, snpm, indiv, numsnps, numind);
+ return;
- case PED:
- printf("ped output\n") ;
- outped(snpname, indname, gname, snpm, indiv, numsnps, numind, ogmode) ;
- return ;
+ case PED:
+ printf ("ped output\n");
+ outped (snpname, indname, gname, snpm, indiv, numsnps, numind, ogmode);
+ return;
- case PACKEDPED:
- printf("packedped output\n") ;
- outpackped(snpname, indname, gname, snpm, indiv, numsnps, numind, ogmode) ;
- return ;
+ case PACKEDPED:
+ printf ("packedped output\n");
+ outpackped (snpname, indname, gname, snpm, indiv, numsnps, numind,
+ ogmode);
+ return;
case PACKEDANCESTRYMAP:
- if (snpname != NULL) printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
- packem = YES ;
- printdata(gname, indname, snpm, indiv, numsnps, numind, packem) ;
- return ;
-
- case ANCESTRYMAP:
- default:
- if (snpname != NULL) printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
- packem = NO ;
- if (numsnps > (sizelimit/numind)) packem = YES ;
- printdata(gname, indname, snpm, indiv, numsnps, numind, packem) ;
- return ;
- }
+ if (snpname != NULL)
+ printsnps (snpname, snpm, numsnps, indiv, NO, NO);
+ packem = YES;
+ printdata (gname, indname, snpm, indiv, numsnps, numind, packem);
+ return;
+
+ case ANCESTRYMAP:
+ default:
+ if (snpname != NULL)
+ printsnps (snpname, snpm, numsnps, indiv, NO, NO);
+ packem = NO;
+ if (numsnps > (sizelimit / numind))
+ packem = YES;
+ printdata (gname, indname, snpm, indiv, numsnps, numind, packem);
+ return;
+ }
}
/* ---------------------------------------------------------------------------------------------------- */
-void outeigenstrat(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv, int numsnps,
- int numind) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char ss[MAXSTR] ;
+void
+outeigenstrat (char *snpname, char *indname, char *gname, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind)
+{
+ FILE *fff, *ifile;
+ int g, i, k;
+ SNP *cupt;
+ Indiv *indx;
+ char ss[MAXSTR];
- settersemode(YES) ;
- if (snpname != NULL)
- printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
+ settersemode (YES);
+ if (snpname != NULL)
+ printsnps (snpname, snpm, numsnps, indiv, NO, NO);
// Print individual data to .ind file
- if (indname != NULL) {
- openit(indname, &ifile, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- strcpy(ss, indx -> egroup) ;
- if (qtmode) {
- sprintf(ss, "%9.3f", indx -> rawqval) ;
- }
- fprintf(ifile,"%20s %c %10s",indx->ID, indx->gender,ss);
- fprintf(ifile,"\n") ;
- continue ;
+ if (indname != NULL)
+ {
+ openit (indname, &ifile, "w");
+ for (i = 0; i < numind; i++)
+ {
+ indx = indiv[i];
+ if (indx->ignore)
+ continue;
+ strcpy (ss, indx->egroup);
+ if (qtmode)
+ {
+ sprintf (ss, "%9.3f", indx->rawqval);
+ }
+ fprintf (ifile, "%20s %c %10s", indx->ID, indx->gender, ss);
+ fprintf (ifile, "\n");
+ continue;
+ }
+ fclose (ifile);
}
- fclose(ifile) ;
- }
- if (gname == NULL) return ;
+ if (gname == NULL)
+ return;
// Print genotypes to .geno file
- openit(gname, &fff, "w") ;
- for (k=0; k< numsnps; k++) {
- cupt = snpm[k] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- for (i=0; i<numind; i++) {
- indx = indiv[i] ;
- if (indx->ignore) continue ;
- g = getgtypes(cupt, i) ;
- if (g<0) g=9 ;
- fprintf(fff, "%1d", g);
- }
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
+ openit (gname, &fff, "w");
+ for (k = 0; k < numsnps; k++)
+ {
+ cupt = snpm[k];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ for (i = 0; i < numind; i++)
+ {
+ indx = indiv[i];
+ if (indx->ignore)
+ continue;
+ g = getgtypes (cupt, i);
+ if (g < 0)
+ g = 9;
+ fprintf (fff, "%1d", g);
+ }
+ fprintf (fff, "\n");
+ }
+ fclose (fff);
}
-
-
/* ---------------------------------------------------------------------------------------------------- */
-void setgref(int **gcounts, int nsnp, int *gvar, int *gref) {
- int tt[5] ;
- int i, kmax ;
-
- for (i=0; i<nsnp; i++) {
- copyiarr(gcounts[i], tt, 5) ;
- tt[0] = -9999 ; // Ensure "missing data" is not ref or var allele
- ivlmaxmin(tt, 5, &kmax, NULL) ;
- gvar[i] = kmax ; // designate major allele "variant"
- if (tt[kmax] == 0) gvar[i] = 5 ;
- tt[kmax] = -9999 ;
- ivlmaxmin(tt, 5, &kmax, NULL) ;
- gref[i] = kmax ; // designate minor allele "variant"
- if (tt[kmax] == 0) gref[i] = 5 ;
- }
+void
+setgref (int **gcounts, int nsnp, int *gvar, int *gref)
+{
+ int tt[5];
+ int i, kmax;
+
+ for (i = 0; i < nsnp; i++)
+ {
+ copyiarr (gcounts[i], tt, 5);
+ tt[0] = -9999; // Ensure "missing data" is not ref or var allele
+ ivlmaxmin (tt, 5, &kmax, NULL);
+ gvar[i] = kmax; // designate major allele "variant"
+ if (tt[kmax] == 0)
+ gvar[i] = 5;
+ tt[kmax] = -9999;
+ ivlmaxmin (tt, 5, &kmax, NULL);
+ gref[i] = kmax; // designate minor allele "variant"
+ if (tt[kmax] == 0)
+ gref[i] = 5;
+ }
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void cleargdata(SNP **snpmarkers, int numsnps, int numindivs) {
+void
+cleargdata (SNP **snpmarkers, int numsnps, int numindivs)
+{
// wipe out all genotype data
- int i , k ;
- SNP *cupt ;
- char *pbuff ;
- double y ;
+ int i, k;
+ SNP *cupt;
+ char *pbuff;
+ double y;
// rlen is number of bytes needed to store each SNP's genotype data in packed mode
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- packlen = rlen*numsnps ;
-
- if (packlen <= 0) fatalx("bad packlen\n") ;
-
- if ((packmode) && (packgenos == NULL)) {
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
- }
-
- pbuff = packgenos ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- // if (cupt -> ignore) continue ;
- if (cupt -> ngtypes == 0) {
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numindivs, int) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numindivs ;
- for (k=0; k<numindivs; ++k) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-}
+ y = (double) (numindivs * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
+ packlen = rlen * numsnps;
+
+ if (packlen <= 0)
+ fatalx ("bad packlen\n");
+
+ if ((packmode) && (packgenos == NULL))
+ {
+ ZALLOC(packgenos, packlen, char);
+ clearepath (packgenos);
+ }
+ pbuff = packgenos;
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ // if (cupt -> ignore) continue ;
+ if (cupt->ngtypes == 0)
+ {
+ if (packmode == NO)
+ {
+ ZALLOC(cupt -> gtypes, numindivs, int);
+ }
+ else
+ {
+ ZALLOC(cupt -> gtypes, 1, int);
+ cupt->pbuff = pbuff;
+ pbuff += rlen;
+ }
+ cupt->ngtypes = numindivs;
+ for (k = 0; k < numindivs; ++k)
+ {
+ putgtypes (cupt, k, -1);
+ }
+ }
+ }
+}
/* ---------------------------------------------------------------------------------------------------- */
-void setgenotypename(char **gname, char *iname) {
- if (ispedfile(iname) == NO) return ;
- if ((*gname != NULL) && strcmp(*gname, "NULL") ==0) {
- *gname = NULL ;
- return ;
- }
- if (*gname != NULL) return ;
- *gname = strdup(iname) ;
+void
+setgenotypename (char **gname, char *iname)
+{
+ if (ispedfile (iname) == NO)
+ return;
+ if ((*gname != NULL) && strcmp (*gname, "NULL") == 0)
+ {
+ *gname = NULL;
+ return;
+ }
+ if (*gname != NULL)
+ return;
+ *gname = strdup (iname);
}
-
-
/* ---------------------------------------------------------------------------------------------------- */
-int maxlinelength(char *fname) {
+int
+maxlinelength (char *fname)
+{
// linelength including \n
- int len, maxlen ;
- int nl, t ;
- FILE *fff ;
+ int len, maxlen;
+ int nl, t;
+ FILE *fff;
- maxlen = -1 ;
+ maxlen = -1;
- len = 0 ;
- nl = (int) (unsigned char) '\n' ;
+ len = 0;
+ nl = (int) (unsigned char) '\n';
- openit(fname, &fff, "r") ;
- while ((t = fgetc(fff)) != EOF) {
- ++len ;
- if (t==nl) {
- maxlen = MAX(maxlen, len) ;
- len = 0 ;
+ openit (fname, &fff, "r");
+ while ((t = fgetc (fff)) != EOF)
+ {
+ ++len;
+ if (t == nl)
+ {
+ maxlen = MAX(maxlen, len);
+ len = 0;
+ }
}
- }
- return maxlen ;
+ return maxlen;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void settersemode(int mode) {
- tersemode = mode ;
+void
+settersemode (int mode)
+{
+ tersemode = mode;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void outindped(char *indname, Indiv **indiv, int numind, int ogmode) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int dcode = 1 ;
-
- if (indname == NULL) return ;
-
- openit(indname, &ifile, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- fprintf(ifile, "%6d %12s", i+1, indx->ID) ;
- fprintf(ifile, " %d %d", 0, 0) ; // parents
- c = indx->gender ;
- pgender = 0 ;
- if (c == 'M') pgender = 1 ;
- if (c == 'F') pgender = 2 ;
- fprintf(ifile, " %d", pgender) ;
- if (ogmode == NO) {
- astatus = indx -> affstatus + 1 ;
- if (qtmode) {
- fprintf(ifile, "%9.3f", indx -> rawqval) ;
- }
- else {
- fprintf(ifile, " %d", astatus) ;
- }
- }
- if (ogmode == YES) fprintf(ifile, " %10s", indx -> egroup) ;
- if (sevencolumnped) fprintf(ifile, " %d", dcode) ;
- fprintf(ifile, "\n") ;
- }
- fclose(ifile) ;
-}
+void
+outindped (char *indname, Indiv **indiv, int numind, int ogmode)
+{
+ FILE *fff, *ifile;
+ int g, i, k;
+ Indiv *indx;
+ char c;
+ int pgender, astatus;
+ int dcode = 1;
+
+ if (indname == NULL)
+ return;
+
+ openit (indname, &ifile, "w");
+ for (i = 0; i < numind; i++)
+ {
+ indx = indiv[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ifile, "%6d %12s", i + 1, indx->ID);
+ fprintf (ifile, " %d %d", 0, 0); // parents
+ c = indx->gender;
+ pgender = 0;
+ if (c == 'M')
+ pgender = 1;
+ if (c == 'F')
+ pgender = 2;
+ fprintf (ifile, " %d", pgender);
+ if (ogmode == NO)
+ {
+ astatus = indx->affstatus + 1;
+ if (qtmode)
+ {
+ fprintf (ifile, "%9.3f", indx->rawqval);
+ }
+ else
+ {
+ fprintf (ifile, " %d", astatus);
+ }
+ }
+ if (ogmode == YES)
+ fprintf (ifile, " %10s", indx->egroup);
+ if (sevencolumnped)
+ fprintf (ifile, " %d", dcode);
+ fprintf (ifile, "\n");
+ }
+ fclose (ifile);
+}
/* ---------------------------------------------------------------------------------------------------- */
-void outped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode) {
+void
+outped (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numind, int ogmode)
+{
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int g1, g2, dcode=1 ;
+ FILE *fff, *ifile;
+ int g, i, k;
+ SNP *cupt;
+ Indiv *indx;
+ char c;
+ int pgender, astatus;
+ int g1, g2, dcode = 1;
- settersemode(YES) ;
- if (snpname != NULL)
- printmap(snpname, snpm, numsnps, indiv) ; // print .map file
+ settersemode (YES);
+ if (snpname != NULL)
+ printmap (snpname, snpm, numsnps, indiv); // print .map file
- if (indname!=NULL)
- outindped(indname, indiv, numind, ogmode) ; // print .pedind file
+ if (indname != NULL)
+ outindped (indname, indiv, numind, ogmode); // print .pedind file
// Here, printt the .ped file
- if (gname == NULL) return ;
- openit(gname, &fff, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- fprintf(fff, "%6d %12s", i+1, indx->ID) ; // make up a family name (index) and print individual name
- fprintf(fff, " %d %d", 0, 0) ; // set parents to "not in data set"
- c = indx->gender ;
- pgender = 0 ;
- if (c == 'M') pgender = 1 ;
- if (c == 'F') pgender = 2 ;
- fprintf(fff, " %d", pgender) ;
- if (ogmode == NO) {
- astatus = indx -> affstatus +1 ;
- if (qtmode) {
- fprintf(fff, "%9.3f", indx -> rawqval) ;
- }
- else
- fprintf(fff, " %d", astatus) ;
- }
- if (ogmode == YES) fprintf(fff, " %10s", indx -> egroup) ;
- if (sevencolumnped) fprintf(fff, " %d", dcode) ;
- for (k=0; k<numsnps; k++) {
- cupt = snpm[k] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- g = getgtypes(cupt, i) ;
- gtox(g, cupt -> alleles, &g1, &g2) ;
- fprintf(fff, " %d %d", g1, g2 ) ;
- if ((g1>4) || (g2>4)) {
- fprintf(fff, "\n") ;
- fflush(fff) ;
- fclose(fff) ;
- printf("bad genotype for snp %s alleles: ", cupt -> ID) ;
- printalleles(cupt, stdout) ;
- printf("\n") ;
- fatalx("trying to make invalid ped file %s\n", gname) ;
- }
- }
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
+ if (gname == NULL)
+ return;
+ openit (gname, &fff, "w");
+ for (i = 0; i < numind; i++)
+ {
+ indx = indiv[i];
+ if (indx->ignore)
+ continue;
+ fprintf (fff, "%6d %12s", i + 1, indx->ID); // make up a family name (index) and print individual name
+ fprintf (fff, " %d %d", 0, 0); // set parents to "not in data set"
+ c = indx->gender;
+ pgender = 0;
+ if (c == 'M')
+ pgender = 1;
+ if (c == 'F')
+ pgender = 2;
+ fprintf (fff, " %d", pgender);
+ if (ogmode == NO)
+ {
+ astatus = indx->affstatus + 1;
+ if (qtmode)
+ {
+ fprintf (fff, "%9.3f", indx->rawqval);
+ }
+ else
+ fprintf (fff, " %d", astatus);
+ }
+ if (ogmode == YES)
+ fprintf (fff, " %10s", indx->egroup);
+ if (sevencolumnped)
+ fprintf (fff, " %d", dcode);
+ for (k = 0; k < numsnps; k++)
+ {
+ cupt = snpm[k];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ g = getgtypes (cupt, i);
+ gtox (g, cupt->alleles, &g1, &g2);
+ fprintf (fff, " %d %d", g1, g2);
+ if ((g1 > 4) || (g2 > 4))
+ {
+ fprintf (fff, "\n");
+ fflush (fff);
+ fclose (fff);
+ printf ("bad genotype for snp %s alleles: ", cupt->ID);
+ printalleles (cupt, stdout);
+ printf ("\n");
+ fatalx ("trying to make invalid ped file %s\n", gname);
+ }
+ }
+ fprintf (fff, "\n");
+ }
+ fclose (fff);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void gtox(int g, char *cvals, int *p1, int *p2) {
+void
+gtox (int g, char *cvals, int *p1, int *p2)
+{
// output values for ped file using allele array
- int g1, g2 ;
+ int g1, g2;
- switch (g) {
+ switch (g)
+ {
case -1:
- *p1 = *p2 = 0;
- return ;
+ *p1 = *p2 = 0;
+ return;
case 0:
- g1 = 1 ;
- g2 = 1;
- break ;
+ g1 = 1;
+ g2 = 1;
+ break;
case 1:
- g1 = 1 ;
- g2 = 2;
- break ;
+ g1 = 1;
+ g2 = 2;
+ break;
case 2:
- g1 = 2 ;
- g2 = 2;
- break ;
+ g1 = 2;
+ g2 = 2;
+ break;
default:
- fatalx("(outped) bug %d\n", g) ;
- }
+ fatalx ("(outped) bug %d\n", g);
+ }
- if (cvals != NULL) {
- g1 = 3-g1 ;
- g2 = 3-g2 ;
- g1 = xpedval(cvals[g1-1]) ;
- g2 = xpedval(cvals[g2-1]) ;
- }
+ if (cvals != NULL)
+ {
+ g1 = 3 - g1;
+ g2 = 3 - g2;
+ g1 = xpedval (cvals[g1 - 1]);
+ g2 = xpedval (cvals[g2 - 1]);
+ }
- *p1 = MIN(g1, g2) ;
- *p2 = MAX(g1, g2) ;
+ *p1 = MIN(g1, g2);
+ *p2 = MAX(g1, g2);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void outpackped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int g1, g2, dcode=1 ;
- unsigned char ibuff[3] ;
- unsigned char *buff ;
- int fdes, ret, blen ;
- int *gtypes ;
- double y ;
-
- settersemode(YES) ;
- if (snpname!=NULL)
- printmap(snpname, snpm, numsnps, indiv) ; // print .map (not .bim)
+void
+outpackped (char *snpname, char *indname, char *gname, SNP **snpm,
+ Indiv **indiv, int numsnps, int numind, int ogmode)
+{
+
+ FILE *fff, *ifile;
+ int g, i, k;
+ SNP *cupt;
+ Indiv *indx;
+ char c;
+ int pgender, astatus;
+ int g1, g2, dcode = 1;
+ unsigned char ibuff[3];
+ unsigned char *buff;
+ int fdes, ret, blen;
+ int *gtypes;
+ double y;
+
+ settersemode (YES);
+ if (snpname != NULL)
+ printmap (snpname, snpm, numsnps, indiv); // print .map (not .bim)
if (indname != NULL) // print .pedind file
- outindped(indname, indiv, numind, ogmode) ;
+ outindped (indname, indiv, numind, ogmode);
- if (gname == NULL) return ;
+ if (gname == NULL)
+ return;
/* magic constants for snp major bed file */
- ibuff[0] = 0x6C ;
- ibuff[1] = 0x1B ;
- ibuff[2] = 0x01 ;
-
+ ibuff[0] = 0x6C;
+ ibuff[1] = 0x1B;
+ ibuff[2] = 0x01;
// blen is number of bytes each SNP's data requires
- y = (double) (numind * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
- ZALLOC(buff, blen, unsigned char) ;
- ZALLOC(gtypes, numind, int) ;
+ y = (double) (numind * 2) / (8 * (double) sizeof(char));
+ blen = nnint (ceil (y));
+ ZALLOC(buff, blen, unsigned char);
+ ZALLOC(gtypes, numind, int);
// open output file and check readability
- fdes = open(gname, O_CREAT | O_TRUNC | O_RDWR, 0666);
- if (fdes<0) {
- perror("bad gname") ;
- fatalx("open failed for %s\n", gname) ;
- }
- if (verbose)
- printf("file %s opened\n", gname) ;
-
- if (fdes<0) {
- perror("bad genoout") ;
- fatalx("open failed for %s\n", gname) ;
- }
-
- if (verbose)
- printf("file %s opened\n", gname) ;
-
- ret = write(fdes, ibuff, 3) ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- for (k=0; k<numind; ++k) {
- g = getgtypes(cupt, k) ;
- if (g>=0) g = 2 - g ;
- gtypes[k] = g ;
- }
- setbedbuff((char *) buff, gtypes, numind) ;
- ret = write(fdes, buff, blen) ;
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpackped) bad write") ;
- }
- }
-
- free(buff) ;
- close(fdes) ;
-}
+ fdes = open (gname, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ if (fdes < 0)
+ {
+ perror ("bad gname");
+ fatalx ("open failed for %s\n", gname);
+ }
+ if (verbose)
+ printf ("file %s opened\n", gname);
+ if (fdes < 0)
+ {
+ perror ("bad genoout");
+ fatalx ("open failed for %s\n", gname);
+ }
-/* ---------------------------------------------------------------------------------------------------- */
-void setbedbuff(char *buff, int *gtypes, int numind ) {
- int i, k ;
- double y ;
- int blen, wnum, wplace, bplace, t, g ;
- unsigned char c ;
-
- y = (double) (numind * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
-
- c = 0xAA ; // missing
- cclear((unsigned char *) buff, c, blen) ; // initialize buffer to "missing"
-
- for (k=0; k<numind; k++) {
- wnum = k/4 ;
- t = k%4 ;
- wplace = 3-t ; // switch for bed
- bplace = 4*wnum + wplace ;
- g = bedval(gtypes[k]) ;
- wbuff((unsigned char *) buff, bplace, g) ;
- }
-}
+ if (verbose)
+ printf ("file %s opened\n", gname);
+ ret = write (fdes, ibuff, 3);
-/* ---------------------------------------------------------------------------------------------------- */
-int bedval(int g) {
- if (g<0) return 1 ;
- if (g==2) return 3 ;
- if (g==1) return 2 ;
- if (g==0) return 0 ;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ for (k = 0; k < numind; ++k)
+ {
+ g = getgtypes (cupt, k);
+ if (g >= 0)
+ g = 2 - g;
+ gtypes[k] = g;
+ }
+ setbedbuff ((char *) buff, gtypes, numind);
+ ret = write (fdes, buff, blen);
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpackped) bad write");
+ }
+ }
+
+ free (buff);
+ close (fdes);
+}
- fatalx("(bedval) bad g value %d\n", g) ;
+/* ---------------------------------------------------------------------------------------------------- */
+void
+setbedbuff (char *buff, int *gtypes, int numind)
+{
+ int i, k;
+ double y;
+ int blen, wnum, wplace, bplace, t, g;
+ unsigned char c;
+
+ y = (double) (numind * 2) / (8 * (double) sizeof(char));
+ blen = nnint (ceil (y));
+
+ c = 0xAA; // missing
+ cclear ((unsigned char *) buff, c, blen); // initialize buffer to "missing"
+
+ for (k = 0; k < numind; k++)
+ {
+ wnum = k / 4;
+ t = k % 4;
+ wplace = 3 - t; // switch for bed
+ bplace = 4 * wnum + wplace;
+ g = bedval (gtypes[k]);
+ wbuff ((unsigned char *) buff, bplace, g);
+ }
}
+/* ---------------------------------------------------------------------------------------------------- */
+int
+bedval (int g)
+{
+ if (g < 0)
+ return 1;
+ if (g == 2)
+ return 3;
+ if (g == 1)
+ return 2;
+ if (g == 0)
+ return 0;
+
+ fatalx ("(bedval) bad g value %d\n", g);
+}
/* ---------------------------------------------------------------------------------------------------- */
-void atopchrom(char *ss, int chrom) {
+void
+atopchrom (char *ss, int chrom)
+{
// ancestry chromosome -> map convention
-/**
- if ( chrom == numchrom+1 ) {
- strcpy(ss, "X") ;
- return ;
- }
- else if ( chrom == numchrom+2 ) {
- strcpy(ss, "Y") ;
- return ;
- }
-*/
- sprintf(ss, "%d", chrom) ;
+ /**
+ if ( chrom == numchrom+1 ) {
+ strcpy(ss, "X") ;
+ return ;
+ }
+ else if ( chrom == numchrom+2 ) {
+ strcpy(ss, "Y") ;
+ return ;
+ }
+ */
+ sprintf (ss, "%d", chrom);
}
/* ---------------------------------------------------------------------------------------------------- */
-int ptoachrom(char *ss) {
+int
+ptoachrom (char *ss)
+{
// map -> ancestry
- char c ;
- c = ss[0] ;
-
- if (c=='X') return (numchrom+1) ;
- if (c=='Y') return (numchrom+2) ;
- return atoi(ss) ;
+ char c;
+ c = ss[0];
+
+ if (c == 'X')
+ return (numchrom + 1);
+ if (c == 'Y')
+ return (numchrom + 2);
+ return atoi (ss);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void printmap(char *snpname, SNP **snpm, int numsnps, Indiv **indiv) {
-
- char ss[5] ;
- int i ;
- FILE *fff ;
- SNP *cupt ;
- char c ;
-
- if (snpname == NULL) return ;
- openit(snpname, &fff, "w") ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- atopchrom(ss, cupt -> chrom) ;
- fprintf(fff, "%-2s", ss) ;
- fprintf(fff, " %12s", cupt -> ID) ;
- fprintf(fff, " %12.6f", cupt -> genpos) ;
- fprintf(fff, " %12.0f", cupt -> physpos) ;
- printalleles(cupt, fff) ;
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
-}
+void
+printmap (char *snpname, SNP **snpm, int numsnps, Indiv **indiv)
+{
+
+ char ss[5];
+ int i;
+ FILE *fff;
+ SNP *cupt;
+ char c;
+ if (snpname == NULL)
+ return;
+ openit (snpname, &fff, "w");
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (outputall == NO)
+ {
+ if (ignoresnp (cupt))
+ continue;
+ if (cupt->isrfake)
+ continue;
+ }
+ atopchrom (ss, cupt->chrom);
+ fprintf (fff, "%-2s", ss);
+ fprintf (fff, " %12s", cupt->ID);
+ fprintf (fff, " %12.6f", cupt->genpos);
+ fprintf (fff, " %12.0f", cupt->physpos);
+ printalleles (cupt, fff);
+ fprintf (fff, "\n");
+ }
+ fclose (fff);
+}
/* ---------------------------------------------------------------------------------------------------- */
-char x2base(int x) {
+char
+x2base (int x)
+{
// 12345 -> ACGTX
- char *blist = "?ACGT" ;
- if (x<0) return '?' ;
- if (x>4) return 'X' ;
- return blist[x] ;
+ char *blist = "?ACGT";
+ if (x < 0)
+ return '?';
+ if (x > 4)
+ return 'X';
+ return blist[x];
}
/* ---------------------------------------------------------------------------------------------------- */
-int xpedval(char c) {
- char bb[2] ;
+int
+xpedval (char c)
+{
+ char bb[2];
- bb[1] = '\0' ;
- bb[0] = c ;
+ bb[1] = '\0';
+ bb[0] = c;
- if (isdigit(c)) return atoi(bb) ;
- return pedval(bb) ;
+ if (isdigit(c))
+ return atoi (bb);
+ return pedval (bb);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int pedval(char *sx) {
- char c ;
-
- c = sx[0] ;
- if (c=='A') return 1 ;
- if (c=='C') return 2 ;
- if (c=='G') return 3 ;
- if (c=='T') return 4 ;
- if (c=='X') return 5 ;
- if (c=='N') return 5 ;
- if (c=='N') return 5 ;
- if (c=='D') return 5 ;
- if (c=='I') return 5 ;
-
- if (c=='1') return 1 ;
- if (c=='2') return 2 ;
- if (c=='3') return 3 ;
- if (c=='4') return 4 ;
- if (c=='0') return 0 ;
-
- if (badpedignore) return 5 ;
-
- return 9 ;
+int
+pedval (char *sx)
+{
+ char c;
+
+ c = sx[0];
+ if (c == 'A')
+ return 1;
+ if (c == 'C')
+ return 2;
+ if (c == 'G')
+ return 3;
+ if (c == 'T')
+ return 4;
+ if (c == 'X')
+ return 5;
+ if (c == 'N')
+ return 5;
+ if (c == 'N')
+ return 5;
+ if (c == 'D')
+ return 5;
+ if (c == 'I')
+ return 5;
+
+ if (c == '1')
+ return 1;
+ if (c == '2')
+ return 2;
+ if (c == '3')
+ return 3;
+ if (c == '4')
+ return 4;
+ if (c == '0')
+ return 0;
+
+ if (badpedignore)
+ return 5;
+
+ return 9;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore) {
-
- int val, i, k, x, j ;
- int t, wnum, wplace ;
- int nsnp ;
- int ngenos = 0 ;
+int
+getbedgenos (char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
+ int numindivs, int nignore)
+{
- SNP *cupt ;
- Indiv *indx ;
+ int val, i, k, x, j;
+ int t, wnum, wplace;
+ int nsnp;
+ int ngenos = 0;
+
+ SNP *cupt;
+ Indiv *indx;
- unsigned char *buff, ibuff[3], jbuff[3] ;
- double y ;
- int blen ;
- int fdes ;
+ unsigned char *buff, ibuff[3], jbuff[3];
+ double y;
+ int blen;
+ int fdes;
// magic numbers for BED identification
- ibuff[0] = 0x6C ;
- ibuff[1] = 0x1B ;
- ibuff[2] = 0x01 ;
+ ibuff[0] = 0x6C;
+ ibuff[1] = 0x1B;
+ ibuff[2] = 0x01;
- cleargdata(snpmarkers, numsnps, numindivs) ;
- nsnp = numsnps ;
+ cleargdata (snpmarkers, numsnps, numindivs);
+ nsnp = numsnps;
- if (pordercheck && (snpordered == NO)) failorder() ;
+ if (pordercheck && (snpordered == NO))
+ failorder ();
// blen is number of bytes needed to store each SNP's genotype
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
- ZALLOC(buff, blen, unsigned char) ;
+ y = (double) (numindivs * 2) / (8 * (double) sizeof(char));
+ blen = nnint (ceil (y));
+ ZALLOC(buff, blen, unsigned char);
// open binary file and check that it is readable
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(getbedgenos) bad open %s\n", gname) ;
- }
- t = read(fdes, jbuff, 3 ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(getbedgenos) bad read") ;
- }
+ fdes = open (gname, O_RDONLY);
+ if (fdes < 0)
+ {
+ perror ("open failure");
+ fatalx ("(getbedgenos) bad open %s\n", gname);
+ }
+ t = read (fdes, jbuff, 3);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(getbedgenos) bad read");
+ }
// check magic
- for (k=0; k<3; k++) {
- if (ibuff[k] != jbuff[k]) {
- fprintf(stderr, "magic failure: ") ;
- fprintf(stderr, " %x %x %x", jbuff[0], jbuff[1], jbuff[2]) ;
- fprintf(stderr, " %x %x %x", ibuff[0], ibuff[1], ibuff[2]) ;
- fprintf(stderr, "\n") ;
- fatalx("(getbedgenos) magic failure\n") ;
+ for (k = 0; k < 3; k++)
+ {
+ if (ibuff[k] != jbuff[k])
+ {
+ fprintf (stderr, "magic failure: ");
+ fprintf (stderr, " %x %x %x", jbuff[0], jbuff[1], jbuff[2]);
+ fprintf (stderr, " %x %x %x", ibuff[0], ibuff[1], ibuff[2]);
+ fprintf (stderr, "\n");
+ fatalx ("(getbedgenos) magic failure\n");
+ }
}
- }
// Read genotype data
- for (i=0; i<nsnp; i++) {
-
- j = snpord[i] ;
- if (snpordered == YES) j = i ;
- if (j<0) fatalx("(readbedgenos) bug\n") ;
- if (j>nsnp) fatalx("(readbedgenos) bug\n") ;
-
- cupt = snpmarkers[j] ;
- t = read(fdes, buff, blen) ;
-
- if (t<0) {
- perror("read failure") ;
- fatalx("(getbedgenos) bad read") ;
- }
- if (cupt -> ignore) continue ;
-
- for (k=0; k<numindivs; k++) {
- indx = indivmarkers[k] ;
- wnum = k/4 ;
- t = k%4 ;
- wplace = 3-t ; // switch for bed
- wplace += 4*wnum ;
- x = rbuff(buff, wplace) ;
- val = ancval(x) ;
- if (checkxval(cupt, indx, val) == NO) val = -1 ;
- putgtypes(cupt, k, val) ;
- if (val >= 0) ++ngenos ;
- }
- }
-
- free(buff) ;
- printf("genotype file processed\n") ;
- return ngenos ;
+ for (i = 0; i < nsnp; i++)
+ {
+
+ j = snpord[i];
+ if (snpordered == YES)
+ j = i;
+ if (j < 0)
+ fatalx ("(readbedgenos) bug\n");
+ if (j > nsnp)
+ fatalx ("(readbedgenos) bug\n");
+
+ cupt = snpmarkers[j];
+ t = read (fdes, buff, blen);
+
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(getbedgenos) bad read");
+ }
+ if (cupt->ignore)
+ continue;
+
+ for (k = 0; k < numindivs; k++)
+ {
+ indx = indivmarkers[k];
+ wnum = k / 4;
+ t = k % 4;
+ wplace = 3 - t; // switch for bed
+ wplace += 4 * wnum;
+ x = rbuff (buff, wplace);
+ val = ancval (x);
+ if (checkxval (cupt, indx, val) == NO)
+ val = -1;
+ putgtypes (cupt, k, val);
+ if (val >= 0)
+ ++ngenos;
+ }
+ }
-}
+ free (buff);
+ printf ("genotype file processed\n");
+ return ngenos;
+}
/* ---------------------------------------------------------------------------------------------------- */
-int ancval(int x) {
+int
+ancval (int x)
+{
// bed -> anc
// 1/22/07 allele flipped
- if (x==1) return -1 ;
- if (x==3) return 0 ;
- if (x==2) return 1 ;
- if (x==0) return 2 ;
- fatalx("(ancval) bad value %d\n", x) ;
+ if (x == 1)
+ return -1;
+ if (x == 3)
+ return 0;
+ if (x == 2)
+ return 1;
+ if (x == 0)
+ return 2;
+ fatalx ("(ancval) bad value %d\n", x);
}
+/* ---------------------------------------------------------------------------------------------------- */
+void
+setomode (enum outputmodetype *outmode, char *omode)
+{
+ char *ss;
+ int len, i;
-/* ---------------------------------------------------------------------------------------------------- */
-void setomode(enum outputmodetype *outmode, char *omode) {
-
- char *ss ;
- int len, i ;
-
- if (outmode == NULL) return ;
- *outmode = PACKEDANCESTRYMAP ;
- if (omode == NULL) return ;
-
- ss = strdup(omode) ;
- len = strlen(ss) ;
- for (i=0; i<len ; i++) {
- ss[i] = tolower(ss[i]) ;
- }
-
- if (strcmp(ss, "eigenstrat") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "ascii") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "alkes") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "ped") == 0) *outmode = PED ;
- if (strcmp(ss, "packedped") == 0) *outmode = PACKEDPED ;
- if (strcmp(ss, "packedancestrymap") == 0) *outmode = PACKEDANCESTRYMAP ;
- if (strcmp(ss, "ancestrymap") == 0) *outmode = ANCESTRYMAP ;
-
- free(ss) ;
-}
+ if (outmode == NULL)
+ return;
+ *outmode = PACKEDANCESTRYMAP;
+ if (omode == NULL)
+ return;
+ ss = strdup (omode);
+ len = strlen (ss);
+ for (i = 0; i < len; i++)
+ {
+ ss[i] = tolower(ss[i]);
+ }
-/* ---------------------------------------------------------------------------------------------------- */
-void snpdecimate(SNP **snpm, int nsnp, int decim, int mindis, int maxdis) {
- int chrom = -1 ;
- SNP **cbuff, *cupt, *cupt2 ;
- int k, k2, n, t ;
-
- printf( "snpdecimate called: decim: %d mindis: %d maxdis: %d\n", decim, mindis, maxdis) ;
- ZALLOC(cbuff, nsnp, SNP *) ;
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- if (cupt -> chrom != chrom) {
- chrom = cupt -> chrom ;
- n = 0 ;
- for (k2=k; k2 <nsnp; ++k2) {
- cupt2 = snpm[k2] ;
- if (cupt2 -> chrom != chrom) break ;
- if (cupt2 -> ignore) continue ;
- if (cupt2 -> isfake) continue ;
- cbuff[n] = cupt2 ;
- ++n ;
- }
- if (n<decim) continue ;
- decimate(cbuff, n, decim, mindis, maxdis) ;
- }
- }
+ if (strcmp (ss, "eigenstrat") == 0)
+ *outmode = EIGENSTRAT;
+ if (strcmp (ss, "ascii") == 0)
+ *outmode = EIGENSTRAT;
+ if (strcmp (ss, "alkes") == 0)
+ *outmode = EIGENSTRAT;
+ if (strcmp (ss, "ped") == 0)
+ *outmode = PED;
+ if (strcmp (ss, "packedped") == 0)
+ *outmode = PACKEDPED;
+ if (strcmp (ss, "packedancestrymap") == 0)
+ *outmode = PACKEDANCESTRYMAP;
+ if (strcmp (ss, "ancestrymap") == 0)
+ *outmode = ANCESTRYMAP;
+
+ free (ss);
}
-
+/* ---------------------------------------------------------------------------------------------------- */
+void
+snpdecimate (SNP **snpm, int nsnp, int decim, int mindis, int maxdis)
+{
+ int chrom = -1;
+ SNP **cbuff, *cupt, *cupt2;
+ int k, k2, n, t;
+
+ printf ("snpdecimate called: decim: %d mindis: %d maxdis: %d\n", decim,
+ mindis, maxdis);
+ ZALLOC(cbuff, nsnp, SNP *);
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ if (cupt->chrom != chrom)
+ {
+ chrom = cupt->chrom;
+ n = 0;
+ for (k2 = k; k2 < nsnp; ++k2)
+ {
+ cupt2 = snpm[k2];
+ if (cupt2->chrom != chrom)
+ break;
+ if (cupt2->ignore)
+ continue;
+ if (cupt2->isfake)
+ continue;
+ cbuff[n] = cupt2;
+ ++n;
+ }
+ if (n < decim)
+ continue;
+ decimate (cbuff, n, decim, mindis, maxdis);
+ }
+ }
+}
/* ---------------------------------------------------------------------------------------------------- */
-void decimate(SNP **cbuff, int n, int decim, int mindis, int maxdis) {
- int k, t, u, dis, len ;
- int *ttt ;
- SNP *cupt ;
-
- cupt = cbuff[0] ;
- if (n<2) return ;
- if (n<decim) return ;
- ZALLOC(ttt, n, int) ;
- for (k=1; k<n; ++k) {
- dis = (int) (cbuff[k] -> physpos - cbuff[k-1] -> physpos) ;
- if (dis > maxdis) {
- decimate(cbuff, k-1, decim, mindis, maxdis) ;
- decimate(cbuff+k, n-k, decim, mindis, maxdis) ;
- return ;
- }
- }
- t = ranmod(decim) ;
- ttt[t] = 1 ;
-
- u = t + decim ;
-
- for (;;) {
- if (u>=n) break ;
- dis = (int) (cbuff[u] -> physpos - cbuff[t] -> physpos) ;
- if (dis<mindis) {
- ++u ;
- continue ;
- }
- len = u-t-1 ;
- ivclear(ttt+t+1, 1, len) ;
- t = u ;
- u = t + decim ;
- }
- for (k=0 ; k < n; ++k) {
- if (ttt[k] == 1) cbuff[k] -> ignore = YES ;
- }
+void
+decimate (SNP **cbuff, int n, int decim, int mindis, int maxdis)
+{
+ int k, t, u, dis, len;
+ int *ttt;
+ SNP *cupt;
+
+ cupt = cbuff[0];
+ if (n < 2)
+ return;
+ if (n < decim)
+ return;
+ ZALLOC(ttt, n, int);
+ for (k = 1; k < n; ++k)
+ {
+ dis = (int) (cbuff[k]->physpos - cbuff[k - 1]->physpos);
+ if (dis > maxdis)
+ {
+ decimate (cbuff, k - 1, decim, mindis, maxdis);
+ decimate (cbuff + k, n - k, decim, mindis, maxdis);
+ return;
+ }
+ }
+ t = ranmod (decim);
+ ttt[t] = 1;
+
+ u = t + decim;
+
+ for (;;)
+ {
+ if (u >= n)
+ break;
+ dis = (int) (cbuff[u]->physpos - cbuff[t]->physpos);
+ if (dis < mindis)
+ {
+ ++u;
+ continue;
+ }
+ len = u - t - 1;
+ ivclear (ttt + t + 1, 1, len);
+ t = u;
+ u = t + decim;
+ }
+ for (k = 0; k < n; ++k)
+ {
+ if (ttt[k] == 1)
+ cbuff[k]->ignore = YES;
+ }
// debug
- if (verbose) {
- for (k=0 ; k < n; ++k) {
- printf("zz %6d %20s %20d %3d\n", k, cbuff[k] -> ID, (int) cbuff[k] -> physpos, ttt[k]) ;
+ if (verbose)
+ {
+ for (k = 0; k < n; ++k)
+ {
+ printf ("zz %6d %20s %20d %3d\n", k, cbuff[k]->ID,
+ (int) cbuff[k]->physpos, ttt[k]);
+ }
}
- }
- free(ttt) ;
+ free (ttt);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int killhir2(SNP **snpm, int numsnps, int numind, double physlim, double genlim, double rhothresh) {
+int
+killhir2 (SNP **snpm, int numsnps, int numind, double physlim, double genlim,
+ double rhothresh)
+{
// physlim = genlim = 0 => kill monomorphs
- double *badbuff ;
- int *xbadbuff ;
- SNP *cupt, *cupt1, *cupt2 ;
+ double *badbuff;
+ int *xbadbuff;
+ SNP *cupt, *cupt1, *cupt2;
#define BADBUFFSIZE 100000 ;
- int badbuffsize = BADBUFFSIZE ;
- int i,j, k, nbad, kmax, kmin, t, j1, j2, lo, hi ;
- int *gtypes ;
- double *x1, *x2, mean, dis, *p1 ;
- int nkill = 0, tj ;
- double y1, y2, y, rho, smax ;
- double **xx1, *yy1 ;
- SNP **snpxl ;
-
- if (physlim<0) return 0 ;
- if (genlim<0) return 0 ;
-
- // step 1 give score to each SNP
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- cupt -> score = numvalidgtypes(cupt) ;
- cupt -> score += DRAND() ; // jitter
- }
-
- ZALLOC(badbuff, badbuffsize, double) ;
- ZALLOC(xbadbuff, badbuffsize, int) ;
- ZALLOC(x1, numind, double) ;
- ZALLOC(x2, numind, double) ;
- ZALLOC(gtypes, numind, int) ;
-
- xx1 = initarray_2Ddouble(10000, numind, 0.0) ;
- ZALLOC(yy1, 10000, double) ;
- ZALLOC(snpxl, 10000, SNP *) ;
-
- for (i=0; i<numsnps; i+=5000) {
-
- lo = i ;
- hi = i+10000-1 ;
- hi = MIN(hi, numsnps-1) ;
-
- for (j=lo; j <=hi ; ++j) {
- p1 = xx1[j-lo] ;
- cupt = snpm[j] ;
- snpxl[j-lo] = cupt ;
- grabgtypes(gtypes, cupt, numind) ;
- floatit(p1, gtypes, numind) ;
- vvadjust(p1, numind, NULL) ;
- y1 = asum2(p1, numind) ;
- yy1[j-lo] = y1 ;
- if (y1<0.01) {
- ++nkill ;
- cupt -> ignore = YES ;
- }
- }
- for (j1 = 0 ; j1 < 5000; ++j1) {
- if (j1>(hi-lo)) break ;
- cupt1 = snpxl[j1] ;
- if (cupt1 -> ignore) continue ;
- nbad = 0 ;
- tj = 0 ;
- for (j2=j1+1; j2 <= hi-lo; ++j2) {
- cupt2 = snpxl[j2] ;
- if (cupt2 -> ignore) continue ;
- if (cupt2 -> chrom != cupt1 -> chrom) break ;
-
- dis = cupt2 -> genpos - cupt1 -> genpos ;
- if (dis > genlim) break ;
-
- dis = cupt2 -> physpos - cupt1 -> physpos ;
- if (dis > physlim) break ;
- ++tj ;
-
- y1 = yy1[j1] ;
- y2 = yy1[j2] ;
-
- y = vdot(xx1[j1], xx1[j2], numind) / sqrt(y1*y2) ; // compute correlation
- rho = y * y ;
- if (rho < rhothresh) continue ;
- badbuff[nbad] = cupt2 -> score ;
- xbadbuff[nbad] = j2+lo ;
- ++nbad ;
-
- }
- t = (j1+lo) % 100 ;
- if (nbad == 0) continue ;
- vlmaxmin(badbuff, nbad, &kmax, &kmin) ;
- smax = snpm[kmax] -> score ;
- if (smax > cupt1 -> score) {
- cupt1 -> ignore = YES ;
- ++nkill ;
- continue ;
- }
- for (k=0; k<nbad; ++k) {
- j = xbadbuff[k] ;
- snpm[j] -> ignore = YES ;
- ++nkill ;
- }
- }
- }
-
-
- free2D(&xx1, 10000) ;
- free(yy1) ;
- free(snpxl) ;
- free(gtypes) ;
- free(badbuff) ;
- free(xbadbuff) ;
- free(x1) ;
- free(x2) ;
+ int badbuffsize = BADBUFFSIZE
+ ;
+ int i, j, k, nbad, kmax, kmin, t, j1, j2, lo, hi;
+ int *gtypes;
+ double *x1, *x2, mean, dis, *p1;
+ int nkill = 0, tj;
+ double y1, y2, y, rho, smax;
+ double **xx1, *yy1;
+ SNP **snpxl;
+
+ if (physlim < 0)
+ return 0;
+ if (genlim < 0)
+ return 0;
+
+ // step 1 give score to each SNP
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ if (cupt->ignore)
+ continue;
+ cupt->score = numvalidgtypes (cupt);
+ cupt->score += DRAND(); // jitter
+ }
+
+ ZALLOC(badbuff, badbuffsize, double);
+ ZALLOC(xbadbuff, badbuffsize, int);
+ ZALLOC(x1, numind, double);
+ ZALLOC(x2, numind, double);
+ ZALLOC(gtypes, numind, int);
+
+ xx1 = initarray_2Ddouble (10000, numind, 0.0);
+ ZALLOC(yy1, 10000, double);
+ ZALLOC(snpxl, 10000, SNP *);
+
+ for (i = 0; i < numsnps; i += 5000)
+ {
+
+ lo = i;
+ hi = i + 10000 - 1;
+ hi = MIN(hi, numsnps - 1);
+
+ for (j = lo; j <= hi; ++j)
+ {
+ p1 = xx1[j - lo];
+ cupt = snpm[j];
+ snpxl[j - lo] = cupt;
+ grabgtypes (gtypes, cupt, numind);
+ floatit (p1, gtypes, numind);
+ vvadjust (p1, numind, NULL);
+ y1 = asum2 (p1, numind);
+ yy1[j - lo] = y1;
+ if (y1 < 0.01)
+ {
+ ++nkill;
+ cupt->ignore = YES;
+ }
+ }
+ for (j1 = 0; j1 < 5000; ++j1)
+ {
+ if (j1 > (hi - lo))
+ break;
+ cupt1 = snpxl[j1];
+ if (cupt1->ignore)
+ continue;
+ nbad = 0;
+ tj = 0;
+ for (j2 = j1 + 1; j2 <= hi - lo; ++j2)
+ {
+ cupt2 = snpxl[j2];
+ if (cupt2->ignore)
+ continue;
+ if (cupt2->chrom != cupt1->chrom)
+ break;
+
+ dis = cupt2->genpos - cupt1->genpos;
+ if (dis > genlim)
+ break;
+
+ dis = cupt2->physpos - cupt1->physpos;
+ if (dis > physlim)
+ break;
+ ++tj;
+
+ y1 = yy1[j1];
+ y2 = yy1[j2];
+
+ y = vdot (xx1[j1], xx1[j2], numind) / sqrt (y1 * y2); // compute correlation
+ rho = y * y;
+ if (rho < rhothresh)
+ continue;
+ badbuff[nbad] = cupt2->score;
+ xbadbuff[nbad] = j2 + lo;
+ ++nbad;
+
+ }
+ t = (j1 + lo) % 100;
+ if (nbad == 0)
+ continue;
+ vlmaxmin (badbuff, nbad, &kmax, &kmin);
+ smax = snpm[kmax]->score;
+ if (smax > cupt1->score)
+ {
+ cupt1->ignore = YES;
+ ++nkill;
+ continue;
+ }
+ for (k = 0; k < nbad; ++k)
+ {
+ j = xbadbuff[k];
+ snpm[j]->ignore = YES;
+ ++nkill;
+ }
+ }
+ }
+
+ free2D (&xx1, 10000);
+ free (yy1);
+ free (snpxl);
+ free (gtypes);
+ free (badbuff);
+ free (xbadbuff);
+ free (x1);
+ free (x2);
// re-initialize scores
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- cupt -> score = 0.0 ;
- }
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ cupt->score = 0.0;
+ }
- printf("killr2 complete\n") ;
- return nkill ;
+ printf ("killr2 complete\n");
+ return nkill;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int vvadjust(double *cc, int n, double *pmean) {
+int
+vvadjust (double *cc, int n, double *pmean)
+{
// take off mean force missing to zero
// simpler version of vadjust
- double ynum, ysum, y, ymean ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum <= 1.5) {
- // no data or monomorphic
- vzero(cc, n) ;
- if (pmean != NULL) *pmean = ysum/(ynum+1.0e-8) ;
- return nmiss ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0)
- cc[i] = 0.0 ;
- else
- cc[i] -= ymean ;
- }
- if (pmean != NULL)
- *pmean = ymean ;
- return nmiss ;
+ double ynum, ysum, y, ymean;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum <= 1.5)
+ {
+ // no data or monomorphic
+ vzero (cc, n);
+ if (pmean != NULL)
+ *pmean = ysum / (ynum + 1.0e-8);
+ return nmiss;
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ return nmiss;
}
-
-
-
/* ---------------------------------------------------------------------------------------------------- */
-static int setskipit(char *sx) {
- int skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- if (strcmp(sx,"SNP_ID") == 0) skipit = YES ;
- if (strcmp(sx,"Indiv_ID") == 0) skipit = YES ;
- if (strcmp(sx,"Chr") == 0) skipit = YES ;
- return skipit ;
+static int
+setskipit (char *sx)
+{
+ int skipit = NO;
+ if (sx[0] == '#')
+ skipit = YES;
+ if (strcmp (sx, "SNP_ID") == 0)
+ skipit = YES;
+ if (strcmp (sx, "Indiv_ID") == 0)
+ skipit = YES;
+ if (strcmp (sx, "Chr") == 0)
+ skipit = YES;
+ return skipit;
}
-
-
/* ---------------------------------------------------------------------------------------------------- */
-int inpack2(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
+int
+inpack2 (char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
+{
// load up packed genotype file for merge.
-
- char **arrx, junk[10] ;
- int n, num, ihash, shash, i, g, j, k, t, g1, g2 ;
- int xihash, xshash, xnsnp, xnind ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt, *cupt2 ;
- SNP xsnp ;
- double y ;
- unsigned char *buff, *tbuff ;
- int fdes, ret ;
- char *packit, *pbuff ;
- int nbad = 0 ;
- n = numind ;
-
- ZALLOC(arrx, n, char *) ;
+
+ char **arrx, junk[10];
+ int n, num, ihash, shash, i, g, j, k, t, g1, g2;
+ int xihash, xshash, xnsnp, xnind;
+ int nind, nsnp, irec;
+ Indiv *indx;
+ SNP *cupt, *cupt2;
+ SNP xsnp;
+ double y;
+ unsigned char *buff, *tbuff;
+ int fdes, ret;
+ char *packit, *pbuff;
+ int nbad = 0;
+ n = numind;
+
+ ZALLOC(arrx, n, char *);
// compute hashes to compare with file
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
- ihash = hasharr(arrx, num) ;
- nind= num ;
-
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- arrx[num] = strdup(cupt -> ID) ;
- ++num ;
- }
- shash = hasharr(arrx, num) ;
- nsnp = num ;
- freeup(arrx, num) ;
- free(arrx) ;
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ indx = indiv[i];
+ arrx[num] = strdup (indx->ID);
+ ++num;
+ }
+ ihash = hasharr (arrx, num);
+ nind = num;
+
+ freeup (arrx, num);
+ free (arrx);
+
+ n = numsnps;
+ ZALLOC(arrx, n, char *);
+ num = 0;
+ for (i = 0; i < n; i++)
+ {
+ cupt = snpm[i];
+ arrx[num] = strdup (cupt->ID);
+ ++num;
+ }
+ shash = hasharr (arrx, num);
+ nsnp = num;
+ freeup (arrx, num);
+ free (arrx);
// rlen is number of bytes each SNP's data requires in packed format
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
- ZALLOC(tbuff, rlen, unsigned char) ;
+ y = (double) (nind * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
+ ZALLOC(buff, rlen, unsigned char);
+ ZALLOC(tbuff, rlen, unsigned char);
// openfile and check readability
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(inpack2) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, rlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack2) bad read") ;
- }
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
-
- if (xnind != nind) fatalx("(inpack2) nind mismatch %d %d \n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("(inpack2) nsnp mismatch\n") ;
- if (xihash != ihash) fatalx("(inpack2) ihash mismatch\n") ;
- if (xshash != shash) fatalx("(inpack2) shash mismatch\n") ;
+ fdes = open (gname, O_RDONLY);
+ if (fdes < 0)
+ {
+ perror ("open failure");
+ fatalx ("(inpack2) bad open %s\n", gname);
+ }
+ t = read (fdes, buff, rlen);
+ if (t < 0)
+ {
+ perror ("read failure");
+ fatalx ("(inpack2) bad read");
+ }
+ sscanf ((char *) buff, "GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash);
+ if (xnind != nind)
+ fatalx ("(inpack2) nind mismatch %d %d \n", nind, xnind);
+ if (xnsnp != nsnp)
+ fatalx ("(inpack2) nsnp mismatch\n");
+ if (xihash != ihash)
+ fatalx ("(inpack2) ihash mismatch\n");
+ if (xshash != shash)
+ fatalx ("(inpack2) shash mismatch\n");
// now copy genotypes
- for (i=0; i<n ; i++) {
- t = read(fdes, tbuff, rlen) ;
- if (t != rlen) {
- perror("read failure") ;
- fatalx("(inpack2) bad data read") ;
- }
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- xsnp = *cupt ;
- cupt2 = &xsnp ;
- cupt2 -> pbuff = (char *) tbuff ;
- for (k=0; k<numind; ++k) {
- g2 = getgtypes(cupt2, k) ; // store in temporary buffer
- if (g2<0) continue ;
- g1 = getgtypes(cupt, k) ;
- if ( (g1>=0) && (g1 != g2)) ++nbad ; // inconsistent data
- putgtypes(cupt, k, g2) ;
- }
-
- // now check xhets
- for (k=0; k<numind; ++k) {
- if (cupt -> chrom != (numchrom+1)) break;
- indx = indiv[k] ;
- g = getgtypes(cupt, k) ;
- if (checkxval(cupt, indx, g) == NO) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-
- free(buff) ;
- free(tbuff) ;
- close(fdes) ;
- return nbad ;
+ for (i = 0; i < n; i++)
+ {
+ t = read (fdes, tbuff, rlen);
+ if (t != rlen)
+ {
+ perror ("read failure");
+ fatalx ("(inpack2) bad data read");
+ }
+ cupt = snpm[i];
+ if (cupt->isfake)
+ continue;
+ xsnp = *cupt;
+ cupt2 = &xsnp;
+ cupt2->pbuff = (char *) tbuff;
+ for (k = 0; k < numind; ++k)
+ {
+ g2 = getgtypes (cupt2, k); // store in temporary buffer
+ if (g2 < 0)
+ continue;
+ g1 = getgtypes (cupt, k);
+ if ((g1 >= 0) && (g1 != g2))
+ ++nbad; // inconsistent data
+ putgtypes (cupt, k, g2);
+ }
+
+ // now check xhets
+ for (k = 0; k < numind; ++k)
+ {
+ if (cupt->chrom != (numchrom + 1))
+ break;
+ indx = indiv[k];
+ g = getgtypes (cupt, k);
+ if (checkxval (cupt, indx, g) == NO)
+ {
+ putgtypes (cupt, k, -1);
+ }
+ }
+ }
+
+ free (buff);
+ free (tbuff);
+ close (fdes);
+ return nbad;
}
/* ---------------------------------------------------------------------------------------------------- */
-void getgenos_list(char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) {
+void
+getgenos_list (char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers,
+ int numsnps, int numindivs, int nignore)
+{
- char **fnames, *fn ;
- int n ;
- int k, nbad, isok ;
+ char **fnames, *fn;
+ int n;
+ int k, nbad, isok;
- dofreeped = NO ;
- n = numlines(genotypelist) ;
- ZALLOC(fnames, n, char *) ;
+ dofreeped = NO;
+ n = numlines (genotypelist);
+ ZALLOC(fnames, n, char *);
// Read in list of genotype files
- n = getlist(genotypelist, fnames) ;
+ n = getlist (genotypelist, fnames);
// Load first one the ordinary way
- getgenos(fnames[0], snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
+ getgenos (fnames[0], snpmarkers, indivmarkers, numsnps, numindivs, nignore);
// Load all others
- for (k=1; k<n; ++k) {
- fn = fnames[k] ;
- isok = NO ;
- if (ispack(fn)) {
- nbad = inpack2(fn, snpmarkers, indivmarkers, numsnps, numindivs) ;
- isok = YES ;
- }
- if (iseigenstrat(fn)) {
- nbad = ineigenstrat(fn, snpmarkers, indivmarkers, numsnps, numindivs) ;
- isok = YES ;
+ for (k = 1; k < n; ++k)
+ {
+ fn = fnames[k];
+ isok = NO;
+ if (ispack (fn))
+ {
+ nbad = inpack2 (fn, snpmarkers, indivmarkers, numsnps, numindivs);
+ isok = YES;
+ }
+ if (iseigenstrat (fn))
+ {
+ nbad = ineigenstrat (fn, snpmarkers, indivmarkers, numsnps,
+ numindivs);
+ isok = YES;
+ }
+ if (nbad > 0)
+ printf ("%s genotypes mismatches: %d\n", fn, nbad);
+ if (isok == NO)
+ fatalx ("file %s must be packed or eigenstrat format\n");
}
- if (nbad>0) printf("%s genotypes mismatches: %d\n", fn, nbad) ;
- if (isok == NO) fatalx("file %s must be packed or eigenstrat format\n") ;
- }
- dofreeped = YES ;
- freeped() ;
+ dofreeped = YES;
+ freeped ();
- free(fnames) ;
+ free (fnames);
}
-
-
/* ---------------------------------------------------------------------------------------------------- */
-int setsdpos( SNPDATA *sdpt, int pos)
+int
+setsdpos (SNPDATA *sdpt, int pos)
{
- int t ;
- char ss[10], *sx ;
-
- sdpt -> ppos = pos ;
- strcpy(ss, sdpt -> cchrom) ;
- mkupper(ss) ;
-
- sdpt -> chimpfudge = chimpmode ;
-
- sx = strstr(ss, "CHR") ;
- if (sx != NULL) sx = ss+3 ;
- else sx = ss ;
-
- t = strcmp(sx, "2B") ;
- if (t==0) {
- sdpt -> ppos += 200000000 ;
- sdpt -> chimpfudge = YES ;
- }
- t = strcmp(sx, "2A") ;
- if (t==0) {
- sdpt -> chimpfudge = YES ;
- }
- return sdpt -> chimpfudge ;
+ int t;
+ char ss[10], *sx;
+
+ sdpt->ppos = pos;
+ strcpy (ss, sdpt->cchrom);
+ mkupper (ss);
+
+ sdpt->chimpfudge = chimpmode;
+
+ sx = strstr (ss, "CHR");
+ if (sx != NULL)
+ sx = ss + 3;
+ else
+ sx = ss;
+
+ t = strcmp (sx, "2B");
+ if (t == 0)
+ {
+ sdpt->ppos += 200000000;
+ sdpt->chimpfudge = YES;
+ }
+ t = strcmp (sx, "2A");
+ if (t == 0)
+ {
+ sdpt->chimpfudge = YES;
+ }
+ return sdpt->chimpfudge;
}
-int str2chrom(char *sss) {
- char ss[6] ;
- if (strlen(sss) > 5) fatalx("bad chrom: %s\n", sss) ;
- if (strstr(sss, "chr") != NULL) {
- strcpy(ss, sss+3) ;
- setchr(YES) ;
- }
- else (strcpy(ss, sss) ) ;
- mkupper(ss) ;
- if (strcmp(ss, "X") == 0) return (numchrom+1) ;
- if (strcmp(ss, "Y") == 0) return (numchrom+2) ;
- if (strcmp(ss, "MT") == 0) return MTCHROM ;
- if (strcmp(ss, "XY") == 0) return XYCHROM ;
- if (strcmp(ss, "2A") == 0) return 2 ;
- if (strcmp(ss, "2B") == 0) return 2 ;
- if (!isnumword(ss)) return -1 ;
- return atoi(ss) ;
+int
+str2chrom (char *sss)
+{
+ char ss[6];
+ if (strlen (sss) > 5)
+ fatalx ("bad chrom: %s\n", sss);
+ if (strstr (sss, "chr") != NULL)
+ {
+ strcpy (ss, sss + 3);
+ setchr (YES);
+ }
+ else
+ (strcpy (ss, sss));
+ mkupper (ss);
+ if (strcmp (ss, "X") == 0)
+ return (numchrom + 1);
+ if (strcmp (ss, "Y") == 0)
+ return (numchrom + 2);
+ if (strcmp (ss, "MT") == 0)
+ return MTCHROM;
+ if (strcmp (ss, "XY") == 0)
+ return XYCHROM;
+ if (strcmp (ss, "2A") == 0)
+ return 2;
+ if (strcmp (ss, "2B") == 0)
+ return 2;
+ if (!isnumword (ss))
+ return -1;
+ return atoi (ss);
}
-
/* ---------------------------------------------------------------------------------------------------- */
-int checksize(int numindivs, int numsnps, enum outputmodetype outputmode) {
+int
+checksize (int numindivs, int numsnps, enum outputmodetype outputmode)
+{
// -1 try packed format
- double y ;
- long z ;
-
- if (sizeof(z) == 8) checksizemode = NO ;
- if (checksizemode == NO) return 1 ;
-
- y = (double) numindivs ;
- y *= (double) numsnps ;
-
- if (y>8.0e9) return -2 ;
-
- switch (outputmode) {
-
- case ANCESTRYMAP:
- if (y>5.0e7) return -1 ;
- break ;
- case EIGENSTRAT:
- if (y>2.0e9) return -1 ;
- break ;
- case PED:
- if (y>4.0e8) return -1 ;
- break ;
- case PACKEDPED:
- break ;
- case PACKEDANCESTRYMAP:
- break ;
- default:
- fatalx("unknown outputmode\n") ;
- }
- return 1 ;
+ double y;
+ long z;
+
+ if (sizeof(z) == 8)
+ checksizemode = NO;
+ if (checksizemode == NO)
+ return 1;
+
+ y = (double) numindivs;
+ y *= (double) numsnps;
+
+ if (y > 8.0e9)
+ return -2;
+
+ switch (outputmode)
+ {
+
+ case ANCESTRYMAP:
+ if (y > 5.0e7)
+ return -1;
+ break;
+ case EIGENSTRAT:
+ if (y > 2.0e9)
+ return -1;
+ break;
+ case PED:
+ if (y > 4.0e8)
+ return -1;
+ break;
+ case PACKEDPED:
+ break;
+ case PACKEDANCESTRYMAP:
+ break;
+ default:
+ fatalx ("unknown outputmode\n");
+ }
+ return 1;
}
/* ---------------------------------------------------------------------------------------------------- */
-int snprawindex(SNPDATA **snpraw, int nreal, char *sname) {
- int k ;
- char **ss ;
+int
+snprawindex (SNPDATA **snpraw, int nreal, char *sname)
+{
+ int k;
+ char **ss;
- freesnpindex() ;
+ freesnpindex ();
// if hash table is not set up, do it now
- if (snprawtab==NO) {
- snprawtab = YES ;
- ZALLOC(ss, nreal, char *) ;
- for (k=0; k< nreal; k++) {
- ss[k] = strdup(snpraw[k] -> ID) ;
- }
-
- // hash SNP data (key=SNP name, data=index in snpraw)
- xloadsearch(ss, nreal) ;
- freeup(ss, nreal) ;
- free(ss) ;
- }
-
- // return index in snpraw
- k = xfindit(sname) ;
- return k ;
-}
+ if (snprawtab == NO)
+ {
+ snprawtab = YES;
+ ZALLOC(ss, nreal, char *);
+ for (k = 0; k < nreal; k++)
+ {
+ ss[k] = strdup (snpraw[k]->ID);
+ }
+ // hash SNP data (key=SNP name, data=index in snpraw)
+ xloadsearch (ss, nreal);
+ freeup (ss, nreal);
+ free (ss);
+ }
+ // return index in snpraw
+ k = xfindit (sname);
+ return k;
+}
/* ---------------------------------------------------------------------------------------------------- */
-void freesnprawindex() {
- if (snprawtab == NO) return ;
- snprawtab = NO ;
- xdestroy() ;
+void
+freesnprawindex ()
+{
+ if (snprawtab == NO)
+ return;
+ snprawtab = NO;
+ xdestroy ();
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void cntpops(int *count, Indiv **indm, int numindivs, char **eglist, int numeg) {
+void
+cntpops (int *count, Indiv **indm, int numindivs, char **eglist, int numeg)
+{
// count number of samples for each pop
- Indiv *indx ;
- int t, k ;
-
- ivzero(count, numeg) ;
- for (k=0; k<numindivs; ++k) {
- indx = indm[k] ;
- if (indx -> ignore) continue ;
- t = indxindex(eglist, numeg, indx -> egroup) ;
- if (t<0) continue ;
- ++count[t] ;
- }
+ Indiv *indx;
+ int t, k;
+
+ ivzero (count, numeg);
+ for (k = 0; k < numindivs; ++k)
+ {
+ indx = indm[k];
+ if (indx->ignore)
+ continue;
+ t = indxindex (eglist, numeg, indx->egroup);
+ if (t < 0)
+ continue;
+ ++count[t];
+ }
}
/* ---------------------------------------------------------------------------------------------------- */
-char *getpackgenos() {
- return packgenos ;
+char *
+getpackgenos ()
+{
+ return packgenos;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void clearpackgenos() {
- packgenos = NULL ;
+void
+clearpackgenos ()
+{
+ packgenos = NULL;
}
-
/* ---------------------------------------------------------------------------------------------------- */
-void genocloseit(genofile *gfile) {
-
- genofile *gpt ;
- SNP *cupt ;
- int i ;
- gpt = gfile ;
-
- free(gpt -> buff) ;
- for (i=0; i< gpt -> numsnps; i++) {
- cupt = gpt -> snpm[i] ;
- freecupt(&cupt) ;
- }
- free(gpt -> snpm) ;
-
- for (i=0; i< gpt -> numindivs; i++) {
- free(gpt -> indivm[i]) ;
- }
- free(gpt -> indivm) ;
-
- close(gpt -> fdes) ;
+void
+genocloseit (genofile *gfile)
+{
+
+ genofile *gpt;
+ SNP *cupt;
+ int i;
+ gpt = gfile;
+
+ free (gpt->buff);
+ for (i = 0; i < gpt->numsnps; i++)
+ {
+ cupt = gpt->snpm[i];
+ freecupt (&cupt);
+ }
+ free (gpt->snpm);
+
+ for (i = 0; i < gpt->numindivs; i++)
+ {
+ free (gpt->indivm[i]);
+ }
+ free (gpt->indivm);
+
+ close (gpt->fdes);
}
/* ---------------------------------------------------------------------------------------------------- */
-int genoopenit(genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m, int numsnp2, int numindiv2, int nignore) {
+int
+genoopenit (genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m,
+ int numsnp2, int numindiv2, int nignore)
+{
// only one gfile can be open
- static genofile xfile ;
- genofile *gpt ;
- double y ;
- int rlen, fdes, t ;
- static unsigned char *buff ;
- int xihash, xshash, xnsnp, xnind ;
- int ihash, shash ;
- char *gname ;
- int nsnp, nind ;
-
-
- if (geno2name == NULL) fatalx("(genoopenit) null name\n") ;
- if (!ispack(geno2name)) fatalx("(genoopenit) not packed ancestrymap format\n") ;
- gpt = *gfile = &xfile ;
- strcpy(gpt -> gname, geno2name) ;
- gpt -> snpm = snp2m ;
- gpt -> indivm = indiv2m ;
- gpt -> numsnps = numsnp2 ;
- gpt -> numindivs = numindiv2 ;
-
- y = (double) (numindiv2 * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
-
- gpt -> rlen = rlen ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
- gpt -> buff = buff ;
-
- fdes = open(geno2name, O_RDONLY) ;
- if (fdes<0) return fdes ;
- gpt -> fdes = fdes ;
- gpt -> snpindex = -1 ;
-
- t = read(fdes, buff, rlen) ;
- if (t<0) fatalx("(genoopenit) bad initial read\n") ;
-
- nsnp = numsnp2 ;
- nind = numindiv2 ;
- gname = geno2name ;
-
- calcishash(snp2m, indiv2m, nsnp, nind, &ihash, &shash) ;
- if (hashcheck) {
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
- if (xnind != nind) fatalx("OOPS number of individuals %d != %d in input files\n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp, gname) ;
- if (xihash != ihash) fatalx("OOPS indiv file has changed since genotype file was created\n") ;
- if (xshash != shash) fatalx("OOPS snp file has changed since genotype file was created\n") ;
- }
-
- return 0 ;
-
-
-/* (Real definition is in admutils.h)
-
-typedef struct {
- char gname[IDSIZE] ;
- SNP **snpm ;
- Indiv **indivm ;
- int numsnps;
- int numindivs ;
- int rlen ;
- int fdes ;
- unsigned char *buff ;
- int snpindex ;
-} genofile ;
-*/
+ static genofile xfile;
+ genofile *gpt;
+ double y;
+ int rlen, fdes, t;
+ static unsigned char *buff;
+ int xihash, xshash, xnsnp, xnind;
+ int ihash, shash;
+ char *gname;
+ int nsnp, nind;
+
+ if (geno2name == NULL)
+ fatalx ("(genoopenit) null name\n");
+ if (!ispack (geno2name))
+ fatalx ("(genoopenit) not packed ancestrymap format\n");
+ gpt = *gfile = &xfile;
+ strcpy (gpt->gname, geno2name);
+ gpt->snpm = snp2m;
+ gpt->indivm = indiv2m;
+ gpt->numsnps = numsnp2;
+ gpt->numindivs = numindiv2;
+
+ y = (double) (numindiv2 * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+
+ gpt->rlen = rlen;
+ rlen = MAX(rlen, 48);
+ ZALLOC(buff, rlen, unsigned char);
+ gpt->buff = buff;
+
+ fdes = open (geno2name, O_RDONLY);
+ if (fdes < 0)
+ return fdes;
+ gpt->fdes = fdes;
+ gpt->snpindex = -1;
+
+ t = read (fdes, buff, rlen);
+ if (t < 0)
+ fatalx ("(genoopenit) bad initial read\n");
+
+ nsnp = numsnp2;
+ nind = numindiv2;
+ gname = geno2name;
+
+ calcishash (snp2m, indiv2m, nsnp, nind, &ihash, &shash);
+ if (hashcheck)
+ {
+ sscanf ((char *) buff, "GENO %d %d %x %x", &xnind, &xnsnp, &xihash,
+ &xshash);
+ if (xnind != nind)
+ fatalx ("OOPS number of individuals %d != %d in input files\n", nind,
+ xnind);
+ if (xnsnp != nsnp)
+ fatalx ("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp,
+ gname);
+ if (xihash != ihash)
+ fatalx (
+ "OOPS indiv file has changed since genotype file was created\n");
+ if (xshash != shash)
+ fatalx ("OOPS snp file has changed since genotype file was created\n");
+ }
-}
+ return 0;
-/* ---------------------------------------------------------------------------------------------------- */
-int genoreadit(genofile *gfile, SNP **pcupt) {
-/*
- return code
- < 0 bad read
- 0 EOF
- rlen good read
-*/
- genofile *gpt ;
- SNP *cupt ;
- int t, rlen, snum ;
- int k ;
-
- cupt = *pcupt = NULL ;
- gpt = gfile ;
- rlen = gpt -> rlen ;
- t = read(gpt -> fdes, gpt -> buff, rlen) ;
- if (t<0) fatalx("(genoreadit) bad read \n") ;
- if (t==0) return 0 ;
- if (t< gpt -> rlen) fatalx("(genoopenit) premature EOF\n") ;
- ++gpt -> snpindex ;
- snum = gpt -> snpindex ;
- cupt = *pcupt = gpt -> snpm[snum] ;
- cupt -> tagnumber = snum ;
- cupt -> pbuff = (char *) gpt -> buff ;
- cupt -> ngtypes = gpt -> numindivs ;
- if (cupt -> gtypes == NULL) ZALLOC(cupt -> gtypes, 1, int) ;
- return rlen ;
-}
+ /* (Real definition is in admutils.h)
+ typedef struct {
+ char gname[IDSIZE] ;
+ SNP **snpm ;
+ Indiv **indivm ;
+ int numsnps;
+ int numindivs ;
+ int rlen ;
+ int fdes ;
+ unsigned char *buff ;
+ int snpindex ;
+ } genofile ;
+ */
-/* ---------------------------------------------------------------------------------------------------- */
-void putped(int num) {
- int *pp ;
- int t ;
-
- pp = snporda[num] ;
- if (pp != NULL) free(pp) ;
- pp = NULL ;
- t = numsnporda[num] = numsnpord ;
- if (t==0) return ;
- ZALLOC(snporda[num], t, int) ;
- pp = snporda[num] ;
- copyiarr(snpord, pp, t) ;
}
/* ---------------------------------------------------------------------------------------------------- */
-void getped(int num) {
- int *pp ;
- int t ;
-
- pp = snpord ;
- if (pp != NULL) free(pp) ;
- pp = NULL ;
- t = numsnpord = numsnporda[num] ;
- if (t==0) return ;
- ZALLOC(snpord, t, int) ;
- pp = snpord ;
- copyiarr(snporda[num], pp, t) ;
+int
+genoreadit (genofile *gfile, SNP **pcupt)
+{
+ /*
+ return code
+ < 0 bad read
+ 0 EOF
+ rlen good read
+ */
+ genofile *gpt;
+ SNP *cupt;
+ int t, rlen, snum;
+ int k;
+
+ cupt = *pcupt = NULL;
+ gpt = gfile;
+ rlen = gpt->rlen;
+ t = read (gpt->fdes, gpt->buff, rlen);
+ if (t < 0)
+ fatalx ("(genoreadit) bad read \n");
+ if (t == 0)
+ return 0;
+ if (t < gpt->rlen)
+ fatalx ("(genoopenit) premature EOF\n");
+ ++gpt->snpindex;
+ snum = gpt->snpindex;
+ cupt = *pcupt = gpt->snpm[snum];
+ cupt->tagnumber = snum;
+ cupt->pbuff = (char *) gpt->buff;
+ cupt->ngtypes = gpt->numindivs;
+ if (cupt->gtypes == NULL)
+ ZALLOC(cupt -> gtypes, 1, int);
+ return rlen;
}
/* ---------------------------------------------------------------------------------------------------- */
-void setbadpedignore() {
- badpedignore = YES ;
+void
+putped (int num)
+{
+ int *pp;
+ int t;
+
+ pp = snporda[num];
+ if (pp != NULL)
+ free (pp);
+ pp = NULL;
+ t = numsnporda[num] = numsnpord;
+ if (t == 0)
+ return;
+ ZALLOC(snporda[num], t, int);
+ pp = snporda[num];
+ copyiarr (snpord, pp, t);
}
/* ---------------------------------------------------------------------------------------------------- */
-void logdeletedsnp(char *snpname, char *cmnt, char *deletesnpoutname) {
- if ( deletesnpoutname != NULL ) {
- FILE *fid = fopen(deletesnpoutname,"a");
- fprintf(fid, "%-40s %-40s\n", snpname, cmnt);
- fclose(fid);
- }
+void
+getped (int num)
+{
+ int *pp;
+ int t;
+
+ pp = snpord;
+ if (pp != NULL)
+ free (pp);
+ pp = NULL;
+ t = numsnpord = numsnporda[num];
+ if (t == 0)
+ return;
+ ZALLOC(snpord, t, int);
+ pp = snpord;
+ copyiarr (snporda[num], pp, t);
}
-
-void sortsnps(SNP **snpa, SNP **snpb, int n)
+/* ---------------------------------------------------------------------------------------------------- */
+void
+setbadpedignore ()
{
- SNP **tsnp, *cupt ;
- int **snppos, *snpindx ;
- int i, k ;
-
- snppos = initarray_2Dint(n, 3, 0) ;
- ZALLOC(snpindx, n, int) ;
- ZALLOC(tsnp, n, SNP *) ;
-
- for (i=0; i<n ; i++) {
- cupt = snpa[i] ;
- snppos[i][0] = cupt -> chrom ;
- snppos[i][1] = nnint((cupt -> genpos)*GDISMUL) ;
- snppos[i][2] = nnint(cupt -> physpos) ;
- }
-
- ZALLOC(snpindx, n, int) ;
- ipsortit(snppos, snpindx, n, 3) ;
-
- for (i=0; i<n; ++i) {
- k = snpindx[i] ;
- tsnp[i] = snpa[k] ;
- }
-
- for (i=0; i<n; ++i) {
- snpb[i] = tsnp[i] ;
- }
-
- free(snpindx) ;
- free2Dint(&snppos, n) ;
- free(tsnp) ;
-
+ badpedignore = YES;
}
+/* ---------------------------------------------------------------------------------------------------- */
+void
+logdeletedsnp (char *snpname, char *cmnt, char *deletesnpoutname)
+{
+ if (deletesnpoutname != NULL)
+ {
+ FILE *fid = fopen (deletesnpoutname, "a");
+ fprintf (fid, "%-40s %-40s\n", snpname, cmnt);
+ fclose (fid);
+ }
+}
+void
+sortsnps (SNP **snpa, SNP **snpb, int n)
+{
+ SNP **tsnp, *cupt;
+ int **snppos, *snpindx;
+ int i, k;
+
+ snppos = initarray_2Dint (n, 3, 0);
+ ZALLOC(snpindx, n, int);
+ ZALLOC(tsnp, n, SNP *);
+
+ for (i = 0; i < n; i++)
+ {
+ cupt = snpa[i];
+ snppos[i][0] = cupt->chrom;
+ snppos[i][1] = nnint ((cupt->genpos) * GDISMUL);
+ snppos[i][2] = nnint (cupt->physpos);
+ }
+ ZALLOC(snpindx, n, int);
+ ipsortit (snppos, snpindx, n, 3);
+ for (i = 0; i < n; ++i)
+ {
+ k = snpindx[i];
+ tsnp[i] = snpa[k];
+ }
+ for (i = 0; i < n; ++i)
+ {
+ snpb[i] = tsnp[i];
+ }
+ free (snpindx);
+ free2Dint (&snppos, n);
+ free (tsnp);
-
-
-
+}
/* doxygen documentation */
/*! \fn int getsnps(char *snpfname, SNP ***snpmarkpt, double spacing,
- char *badsnpname, int *numignore, int numrisks)
+ char *badsnpname, int *numignore, int numrisks)
- \brief Read SNP data from file
- \param snpfname File name (.snp or .map)
- \param snpmarkpt Pointer to array of type SNP * to store data in
- \param spacing
- \param badsnpname Name of file with list of SNPs to ignore (or NULL for none)
- \param numignore ???
- \param numrisks ???
+ \brief Read SNP data from file
+ \param snpfname File name (.snp or .map)
+ \param snpmarkpt Pointer to array of type SNP * to store data in
+ \param spacing
+ \param badsnpname Name of file with list of SNPs to ignore (or NULL for none)
+ \param numignore ???
+ \param numrisks ???
- Returns number of SNPs loaded
+ Returns number of SNPs loaded
*/
-
/*! \fn int readsnpdata(SNPDATA **snpraw, char *fname)
- \brief Read SNP file
- \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
- \param fname Name of SNP file
+ \brief Read SNP file
+ \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
+ \param fname Name of SNP file
- For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
- Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
- Also sets maxgpos[chrom] to highest genetic position in chromosome
+ For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
+ Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
+ Also sets maxgpos[chrom] to highest genetic position in chromosome
*/
-
/*! \fn int readsnpmapdata(SNPDATA **snpraw, char *fname)
- \brief Read PLINK format SNP file
- \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
- \param fname Name of SNP file
+ \brief Read PLINK format SNP file
+ \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
+ \param fname Name of SNP file
- For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
- Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
- Also sets maxgpos[chrom] to highest genetic position in chromosome
+ For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
+ Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
+ Also sets maxgpos[chrom] to highest genetic position in chromosome
*/
-
/*! \fn getsizex(char *fname)
- \brief Count number of non-comment lines in file
- This is the number of SNPs in a .map or .snp file
+ \brief Count number of non-comment lines in file
+ This is the number of SNPs in a .map or .snp file
*/
/*! \fn int ismapfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .map file
- File is assumed to be PLINK if file extension is .map, .bim or .pedsnp
+ \brief Look at file name to determine whether this is a PLINK .map file
+ File is assumed to be PLINK if file extension is .map, .bim or .pedsnp
*/
/*! \fn int ispedfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .ped file.
- File is assumed to be PLINK if file extension is .ped or .fam
+ \brief Look at file name to determine whether this is a PLINK .ped file.
+ File is assumed to be PLINK if file extension is .ped or .fam
*/
/*! \fn int isbedfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .bed file.
- File is assumed to be PLINK if file extension is .ped or .fam
+ \brief Look at file name to determine whether this is a PLINK .bed file.
+ File is assumed to be PLINK if file extension is .ped or .fam
*/
/*! \fn static int setskipit(char *sx)
- \brief Determine whether an input line from the SNP file should be skipped
- \param sx is the first token on the input line
- Skip if this is a comment or a line of column headers.
- /
+ \brief Determine whether an input line from the SNP file should be skipped
+ \param sx is the first token on the input line
+ Skip if this is a comment or a line of column headers.
+ /
-/*! \fn int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing)
- \brief Return (approximate) number of fake SNPs that will be inserted
+ /*! \fn int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing)
+ \brief Return (approximate) number of fake SNPs that will be inserted
- Note: for EIGENSOFT programs, spacing is always set to 0.0 (presumably not for
- ANCESTRYMAP) which results in a return value of 0. The fake SNPs are inserted
- so that the genetic distance between adjacent SNPs is not greater than spacing.
+ Note: for EIGENSOFT programs, spacing is always set to 0.0 (presumably not for
+ ANCESTRYMAP) which results in a return value of 0. The fake SNPs are inserted
+ so that the genetic distance between adjacent SNPs is not greater than spacing.
*/
/*! \fn double nextmesh(double val, double spacing)
- \brief Return least multiple of spacing greater than or equal to val
- (Used by numfakes and loadsnps to count number of fake SNPs.)
+ \brief Return least multiple of spacing greater than or equal to val
+ (Used by numfakes and loadsnps to count number of fake SNPs.)
*/
/*! \fn double interp (double l, double r, double x, double al, double ar)
- \brief Return linear interpolant a fractional x between the points (l,al) and (r, ar)
+ \brief Return linear interpolant a fractional x between the points (l,al) and (r, ar)
*/
-
/*! \fn int getindivs(char *indivfname, Indiv ***indmarkpt)
- \brief Read individual data from file
- \param indivfname File name
- \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
+ \brief Read individual data from file
+ \param indivfname File name
+ \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
*/
/*! \fn int readindpeddata(Indiv **indivmarkers, char *fname) {
- \brief Read individual data from file
- \param indivfname File name
- \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
+ \brief Read individual data from file
+ \param indivfname File name
+ \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
*/
/*! \fn void pedname(char *cbuff, char *sx0, char *sx1)
- \brief Enforce name length requirements and prepend family names if desired.
+ \brief Enforce name length requirements and prepend family names if desired.
*/
-
/*! \fn int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname)
- Not used in EIGENSOFT
+ Not used in EIGENSOFT
*/
/*! \fn int readfreqdata(SNP **snpm, int numsnps, char *inddataname)
- Not used in EIGENSOFT
+ Not used in EIGENSOFT
*/
/*! \fn int setstatus(Indiv **indm, int numindivs, char *smatch)
- \brief Call setstatusv with value YES
+ \brief Call setstatusv with value YES
*/
/*! \fn int setstatusv(Indiv **indm, int numindivs, char *smatch, int val)
- \brief Set affstatus of all individuals with egroup equal to smatch to value val
- \param indm Array in which individuals' data is stored
- \param numindivs Number of individuals in the array
- \param smatch String in individual's field egroup to match
- \param val Value to set affstatus to
+ \brief Set affstatus of all individuals with egroup equal to smatch to value val
+ \param indm Array in which individuals' data is stored
+ \param numindivs Number of individuals in the array
+ \param smatch String in individual's field egroup to match
+ \param val Value to set affstatus to
*/
-
+
/*! \fn int checksize(int numindivs, int numsnps, enum outputmodetype outputmode)
- \brief Enforce size limits on genotype data file
- */
+ \brief Enforce size limits on genotype data file
+ */
/*! \fn int ispack(char *gname)
- \brief Open file and look for GENO at top. If it's there, the file is packed (binary)
+ \brief Open file and look for GENO at top. If it's there, the file is packed (binary)
*/
/*! \fn int iseigenstrat(char *gname)
- \brief If every line in the file is one "word" (i.e., no white space), the file is
- assumed to be EIGENSTRAT format
+ \brief If every line in the file is one "word" (i.e., no white space), the file is
+ assumed to be EIGENSTRAT format
*/
-
+
/*! \fn long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from file
- \param genoname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
+ \brief Read genotype data from file
+ \param genoname Name of genotype data file
+ \param snpmarkers Array in which SNP data is stored
+ \param indivmarkers Array in which individual data is stored
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
+ \param nignore ???
- Returns number of genotypes read
+ Returns number of genotypes read
- Note: Instantiates, uses and destroys the hash table.
+ Note: Instantiates, uses and destroys the hash table.
*/
/*! \fn void genopedcnt(char *gname, int **gcounts, int nsnp)
- \brief Count number of alleles of each type in each SNP
+ \brief Count number of alleles of each type in each SNP
- Return in gcounts[k][n] is number of "n" alleles in SNP k
+ Return in gcounts[k][n] is number of "n" alleles in SNP k
- (This is used to discover and designate ref/var alleles)
+ (This is used to discover and designate ref/var alleles)
*/
/*! \fn void setgref(int **gcounts, int nsnp, int *gvar, int *gref)
- \brief Designate reference and variant alleles by looking at allele counts
+ \brief Designate reference and variant alleles by looking at allele counts
- (This is for use with PED files)
+ (This is for use with PED files)
*/
/*! \fn long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from PLINK .ped format file
+ \brief Read genotype data from PLINK .ped format file
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
+ \param gname Name of genotype data file
+ \param snpmarkers Array in which SNP data is stored
+ \param indivmarkers Array in which individual data is stored
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
+ \param nignore ???
- Returns number of genotypes read
+ Returns number of genotypes read
- Note: Instantiates, uses and destroys the hash table.
+ Note: Instantiates, uses and destroys the hash table.
*/
/*! \fn int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from PLINK .bed format file
+ \brief Read genotype data from PLINK .bed format file
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
+ \param gname Name of genotype data file
+ \param snpmarkers Array in which SNP data is stored
+ \param indivmarkers Array in which individual data is stored
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
+ \param nignore ???
- Returns number of genotypes read
+ Returns number of genotypes read
- Note: Instantiates, uses and destroys the hash table.
+ Note: Instantiates, uses and destroys the hash table.
*/
- /*! \fn int inpack(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Read genotype data from packed ANCESTRYMAP format file
+/*! \fn int inpack(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
+ \brief Read genotype data from packed ANCESTRYMAP format file
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
+ \param gname Name of genotype data file
+ \param snpmarkers Array in which SNP data is stored
+ \param indivmarkers Array in which individual data is stored
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
- Returns number of genotypes read
+ Returns number of genotypes read
- Note: Instantiates, uses and destroys the hash table.
+ Note: Instantiates, uses and destroys the hash table.
*/
/*! \fn void cleargdata(SNP **snpmarkers, int numsnps, int numindivs)
- \brief Wipe out all genotype data
+ \brief Wipe out all genotype data
*/
/*! \fn rmindivs(SNP ** snpm, int numsnps, Indiv **indivmarkers, int numindivs)
- \brief squeeze out ignored individuals
+ \brief squeeze out ignored individuals
- Return number of individuals retained (not ignored)
+ Return number of individuals retained (not ignored)
*/
-
/*! \fn void freecupt(SNP **cuppt)
- \brief Free memory associated with SNP *
+ \brief Free memory associated with SNP *
*/
/*! \fn void clearind(Indiv **indm, int numind)
- \brief Re-initialize all individuals
+ \brief Re-initialize all individuals
*/
/*! \fn void cleartg(indiv **indm, int nind
- \brief Zero out totgamms and totscore fields for all individuals
+ \brief Zero out totgamms and totscore fields for all individuals
*/
/*! \fn void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname)
- \brief Read badsnps file and set ignore flag on all bad SNPs
- \param snpraw Array of initial SNP data structs
- \param nreal Number of elements in snpraw
- \param badsnpname Name of badsnp file
+ \brief Read badsnps file and set ignore flag on all bad SNPs
+ \param snpraw Array of initial SNP data structs
+ \param nreal Number of elements in snpraw
+ \param badsnpname Name of badsnp file
*/
/*! \fn void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids)
- \brief Print SNP output in EIGENSTRAT format
+ \brief Print SNP output in EIGENSTRAT format
*/
/*! \fn void printalleles(SNP *cupt, FILE *fff)
- \brief print SNP's alleles
+ \brief print SNP's alleles
*/
/*! \fn void outfiles(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numindx, int packem, int ogmode)
- \brief Determine which output function to call based on user parameter outputmode
- \param snpname SNP output file name
- \param indname Individual output file name
- \param gname Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numindx Number of elements in indiv
- \param packem not used (used as local variable)
- \param ogmode flag for PED, print quantitative or group phenotype
+ int numsnps, int numindx, int packem, int ogmode)
+ \brief Determine which output function to call based on user parameter outputmode
+ \param snpname SNP output file name
+ \param indname Individual output file name
+ \param gname Genotype output file name
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numindx Number of elements in indiv
+ \param packem not used (used as local variable)
+ \param ogmode flag for PED, print quantitative or group phenotype
*/
/*! \fn void outpack(char *genooutfilename, SNP **snpm, Indiv **nindiv, int numsnps, int numind)
- \brief Print out genotype data in packed ANCESTRYMAP format
- \param genooutfilename Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
-*/
+ \brief Print out genotype data in packed ANCESTRYMAP format
+ \param genooutfilename Genotype output file name
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
+ */
/*! \fn void outeigenstrat(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind)
- \brief Print output in EIGENSTRAT format
- \param snpname SNP output file name
- \param indname Individual output name
- \param gname Genotype output name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
+ int numsnps, int numind)
+ \brief Print output in EIGENSTRAT format
+ \param snpname SNP output file name
+ \param indname Individual output name
+ \param gname Genotype output name
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
*/
-
/*! \fn void outped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind, int ogmode)
- \brief Print output in (unpacked) PED format
-
- \param snpname SNP output file name
- \param indname Individual output file name
- \param gname Genotype output file name
- \param snpm Array with SNP data
- \param indiv Array with individual data
- \param numsnps Number of elements in snpm
- \param numind Number of individuals in indiv
- \param ogmode phenotype output mode (quantitative or discrete)
+ \brief Print output in (unpacked) PED format
+
+ \param snpname SNP output file name
+ \param indname Individual output file name
+ \param gname Genotype output file name
+ \param snpm Array with SNP data
+ \param indiv Array with individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of individuals in indiv
+ \param ogmode phenotype output mode (quantitative or discrete)
*/
-
-
/*! \fn void gtox(int g, char *cvals, int *p1, int *p2)
- \brief Get alleles in PED format
- \param g Diploid genotype (0,1,2 or -1 for "missing")
- \param cvals Array with char ref and var alleles
- \param p1 Output for first allele
- \param p2 Output for second allele
-
- If cvals is NULL, return alleles "1" and "2" (i.e., "A" and "C")
- Otherwise, look up actual alleles. If the diploid is het, the alleles will be printed in the
- order (ref,var) not (var,ref)
+ \brief Get alleles in PED format
+ \param g Diploid genotype (0,1,2 or -1 for "missing")
+ \param cvals Array with char ref and var alleles
+ \param p1 Output for first allele
+ \param p2 Output for second allele
+
+ If cvals is NULL, return alleles "1" and "2" (i.e., "A" and "C")
+ Otherwise, look up actual alleles. If the diploid is het, the alleles will be printed in the
+ order (ref,var) not (var,ref)
*/
/*! \fn void outindped(char *indname, Indiv **indiv, int numind, int ogmode)
- \brief Print out individual names in PEDIND format (i.e., first six or seven columns of PED)
- \param indname Individual output file name
- \param indiv Array with individual data
- \param numind Number of elements in indiv
- \param ogmode Flag for phenotype type (quantitative or discrete)
+ \brief Print out individual names in PEDIND format (i.e., first six or seven columns of PED)
+ \param indname Individual output file name
+ \param indiv Array with individual data
+ \param numind Number of elements in indiv
+ \param ogmode Flag for phenotype type (quantitative or discrete)
*/
/*! \fn void outpackped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode)
- \brief Print data in packed PED format (.bed)
- \param snpname Output SNP file name
- \param indname Output individual file name
- \param gname Output genotype file name
- \param snpm Array with SNP data
- \param indiv Array with individual data
- \param numsnps Number of elements in snpm
- \param numind Number of individuals in indiv
- \param ogmode Flag for phenotype type (quantitative or discrete)
+ int numsnps, int numind, int ogmode)
+ \brief Print data in packed PED format (.bed)
+ \param snpname Output SNP file name
+ \param indname Output individual file name
+ \param gname Output genotype file name
+ \param snpm Array with SNP data
+ \param indiv Array with individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of individuals in indiv
+ \param ogmode Flag for phenotype type (quantitative or discrete)
*/
-
/*! \fn void setbedbuff(char *buff, int *gtypes, int numind)
- \brief Fill buffer with diploid genotypes in BED format
+ \brief Fill buffer with diploid genotypes in BED format
*/
-
/*! \fn void bedval(int g)
- \brief Encode diploid genotype into its packed BED equivalent
+ \brief Encode diploid genotype into its packed BED equivalent
*/
-
/*! \fn void atopchrom(char *ss, int chrom)
- \brief Encode integer chromosome number to its MAP file equivalent
- \param ss output chromosome symbol (0-22 or "X" or "Y") CHANGED 23 24
- \param chrom input chromosome symbol (0-24)
+ \brief Encode integer chromosome number to its MAP file equivalent
+ \param ss output chromosome symbol (0-22 or "X" or "Y") CHANGED 23 24
+ \param chrom input chromosome symbol (0-24)
*/
/*! \fn int ptoachrom(char *ss)
- \brief Encode MAP chromosome symbol to its numerical equivalent
- \param ss input chromosome symbol (0-22 or "X" or "Y")
+ \brief Encode MAP chromosome symbol to its numerical equivalent
+ \param ss input chromosome symbol (0-22 or "X" or "Y")
- Return chromosome number (0-24)
+ Return chromosome number (0-24)
*/
-
/*! \fn void printmap(char *snpname, SNP **snpm, int numsnps, Indiv **indiv)
- \brief Print out SNP data in PLINK .map format
- \param snpname Output SNP file name
- \param snpm Array with SNP data
- \param numsnps Number of elements in snpm
- \param indiv not used
+ \brief Print out SNP data in PLINK .map format
+ \param snpname Output SNP file name
+ \param snpm Array with SNP data
+ \param numsnps Number of elements in snpm
+ \param indiv not used
*/
-
/*! \fn int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash)
- \brief Calculate hashes on individuals and SNPs (to compare with file values.)
- \param snpm Array of SNP data
- \param indiv Array if individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
- \param pihash Output parameter for indiv hash
- \param pshash Output parameter for SNP hash
-
- Return number of SNPs plus number if individuals
+ \brief Calculate hashes on individuals and SNPs (to compare with file values.)
+ \param snpm Array of SNP data
+ \param indiv Array if individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
+ \param pihash Output parameter for indiv hash
+ \param pshash Output parameter for SNP hash
+
+ Return number of SNPs plus number if individuals
*/
/*! \fn void freeped(void)
- \brief destructor for array snpord
+ \brief destructor for array snpord
*/
/*! \fn int readinddata(Indiv **indivmarkers, char *fname)
- \brief Read individual data from input file
- \param indivmarkers Array to store data in
- \param fname Individual input file
+ \brief Read individual data from input file
+ \param indivmarkers Array to store data in
+ \param fname Individual input file
*/
/*! \fn int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname)
- \brief Read theta/lambda data (for ANCESTRYMAP, not used in EIGENSOFT)
+ \brief Read theta/lambda data (for ANCESTRYMAP, not used in EIGENSOFT)
*/
/*! \fn int readfreqata(SNP **snpm, int numsnps, char *inddataname)
- \brief Read allele frequency data (for ANCESTRYMAP, not used in EIGENSOFT)
+ \brief Read allele frequency data (for ANCESTRYMAP, not used in EIGENSOFT)
*/
/*! \fn int checkxval(SNP *cupt, Indiv *indx, int val)
- \brief Check that male X marker is not (invalidly) heterozygous
+ \brief Check that male X marker is not (invalidly) heterozygous
*/
/*! \fn void clearsnp(SNP *cupt)
- \brief Reinitialize all fields in SNP data structure
+ \brief Reinitialize all fields in SNP data structure
*/
-
/*! \fn int rmindivs(SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs)
- \brief Squeeze out individuals with ignore flag set.
- \param snpm Array of SNP data
- \param numsnps Number of elements in snpm
- \param indivmarkers Array of individual data
- \param numindivs Number of elements in indivmarkers
+ \brief Squeeze out individuals with ignore flag set.
+ \param snpm Array of SNP data
+ \param numsnps Number of elements in snpm
+ \param indivmarkers Array of individual data
+ \param numindivs Number of elements in indivmarkers
*/
-
/*! \fn int rmsnps(SNP **snpm, int numsnps)
- \brief Squeeze out SNPs with ignore flag set
- \param snpm Array of SNP data
- \param numsnps Number of elements in snpm
+ \brief Squeeze out SNPs with ignore flag set
+ \param snpm Array of SNP data
+ \param numsnps Number of elements in snpm
*/
/*! \fn void freecupt(SNP **cuppt)
- \brief Free memory associated with SNP data structure
+ \brief Free memory associated with SNP data structure
*/
/*! \fn void clearind(Indiv **indm, int numind)
- \brief Free memory associated with all Indiv data structs in array
+ \brief Free memory associated with all Indiv data structs in array
*/
/*! \fn void cleartg(Indiv **indm, int nind)
- \brief Free memory in two fields of all Indiv data structs in array
+ \brief Free memory in two fields of all Indiv data structs in array
*/
/*! \fn void setug(Indiv **indm, int numind, char gender)
- \brief Set all unknown gender fields to value passed in
+ \brief Set all unknown gender fields to value passed in
*/
/*! \fn void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname)
- \brief Remove bad SNPs from array
- \param snpraw Array of (preliminary) SNP data
- \param nreal Number of elements in snpraw
- \param badsnpname Bad SNP file name
-*/
+ \brief Remove bad SNPs from array
+ \param snpraw Array of (preliminary) SNP data
+ \param nreal Number of elements in snpraw
+ \param badsnpname Bad SNP file name
+ */
/*! \fn int checkfake(char **ss)
- \brief Returns YES if and only if string ss is "fake"
+ \brief Returns YES if and only if string ss is "fake"
*/
/*! \fn void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids)
- \brief Print ANCESTRYMAP format SNP file.
- \param snpoutfilename Name of SNP output file
- \param snpm Array with SNP data
- \param num Number of SNPs in array
- \param indm Array with individual data
- \param printfakes Flag to print fake SNPs
- \param printvalids Flag to print alleles
+ \brief Print ANCESTRYMAP format SNP file.
+ \param snpoutfilename Name of SNP output file
+ \param snpm Array with SNP data
+ \param num Number of SNPs in array
+ \param indm Array with individual data
+ \param printfakes Flag to print fake SNPs
+ \param printvalids Flag to print alleles
*/
/*! \fn void printalleles(SNP *cupt, FILE *fff)
- \brief Print SNP alleles to file
+ \brief Print SNP alleles to file
*/
/*! \fn void printdata(char *genooutfilename, char *indoutfilename, SNP **snpm,
- Indiv **indiv, int numsnps, int numind, int packem)
- \brief Print ANCESTRYMAP format genotype file
- \param genooutfilename Genotype output file name
- \param indoutfilename Individual output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
- \param packem Flag - print in packed mode if set
-*/
+ Indiv **indiv, int numsnps, int numind, int packem)
+ \brief Print ANCESTRYMAP format genotype file
+ \param genooutfilename Genotype output file name
+ \param indoutfilename Individual output file name
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
+ \param packem Flag - print in packed mode if set
+ */
/*! \fn void outpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Print packed ANCESTRYMAP format genotype file
- \param genooutfilename Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
-*/
+ \brief Print packed ANCESTRYMAP format genotype file
+ \param genooutfilename Genotype output file name
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
+ */
/*! \fn int ineigenstrat(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Read EIGENSTRAT genotype file
- \param gname Genotype input file
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
+ \brief Read EIGENSTRAT genotype file
+ \param gname Genotype input file
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of elements in snpm
+ \param numind Number of elements in indiv
- Return number of errors encountered
+ Return number of errors encountered
*/
/*! \fn void clearepath(char *packp)
- \brief Fill memory with 0xFF
+ \brief Fill memory with 0xFF
*/
-
/*! \fn void getsnpsc(char *snpscname, SNP **snpm, int numsnps)
- \brief Read SNP score input file (not used in EIGENSOFT)
+ \brief Read SNP score input file (not used in EIGENSOFT)
*/
/*! \fn void setepath(SNP **snpm, int nsnps)
- \brief Clear packed genotype memory (i.e., set to "missing") and point SNP buffers-pointers to the SNP's position in packed memory.
+ \brief Clear packed genotype memory (i.e., set to "missing") and point SNP buffers-pointers to the SNP's position in packed memory.
*/
/*! \fn int getpedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read PLINK format genotype file
- \param gname Name of genotype input file
- \param snpmarkers Array of SNP data
- \param indivmarkers Array of individual data
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore (not used)
+ \brief Read PLINK format genotype file
+ \param gname Name of genotype input file
+ \param snpmarkers Array of SNP data
+ \param indivmarkers Array of individual data
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
+ \param nignore (not used)
*/
-
/*! \fn void setgenotypename(char **gname, char *iname)
- \brief Copy PED genotypename from iname to *gname, checking that iname is not "NULL."
+ \brief Copy PED genotypename from iname to *gname, checking that iname is not "NULL."
*/
-
/*! \fn int maxlinelength(char *fname)
- \brief Find and return length of longest line in file
+ \brief Find and return length of longest line in file
*/
-
/*! \fn char x2base(int x)
- \brief Encode digit to char-type allele (PLINK convention)
+ \brief Encode digit to char-type allele (PLINK convention)
*/
/*! \fn int xpedval(char c)
- \brief Encode char-type allele to digit (PLINK convention)
+ \brief Encode char-type allele to digit (PLINK convention)
*/
/*! \fn int pedval(char *sx)
- \brief Encode char-type allele to digit (PLINK convention)
+ \brief Encode char-type allele to digit (PLINK convention)
*/
/*! \fn int ancval(int x)
- \brief Encode BED allele digit to ANCESTRYMAP equivalent
+ \brief Encode BED allele digit to ANCESTRYMAP equivalent
*/
/*! \fn void setomode(enum outputmodetype *outmode, char *omode)
- \brief Set output mode from user parameter omode (default is packed ANCESTRYMAP)
+ \brief Set output mode from user parameter omode (default is packed ANCESTRYMAP)
*/
/*! \fn void decimate(SNP **cbuff, int n, int decim, int mindis, int maxdis)
- \brief (Undocumented feature) Prune SNPs
-*/
+ \brief (Undocumented feature) Prune SNPs
+ */
/*! \fn void snpdecimate(SNP **snpm, int nsnp, int decim, int mindis, int maxdis)
- \brief (Undocumented feature) Prune SNPs
-*/
+ \brief (Undocumented feature) Prune SNPs
+ */
/*! \fn int killhir2(SNP **snpm, int numsnps, int numind, double physlim, double genlim, double rhothresh)
- \brief Remove one of each pair of SNPs with r-squared greater than rhothresh
- \param snpm Array of SNP data
- \param numsnps Number of SNPs in snpm
- \param numind Number of individuals in each SNP's genotype data
- \param physlim Only consider SNP pairs closer than this
- \param genlim Only consider SNP pairs closer than this
- \param rhothresh Maximum permissible r-squared value
-*/
-
+ \brief Remove one of each pair of SNPs with r-squared greater than rhothresh
+ \param snpm Array of SNP data
+ \param numsnps Number of SNPs in snpm
+ \param numind Number of individuals in each SNP's genotype data
+ \param physlim Only consider SNP pairs closer than this
+ \param genlim Only consider SNP pairs closer than this
+ \param rhothresh Maximum permissible r-squared value
+ */
/*! \fn int vvadjust(double *cc, int n, double *pmean)
- \brief Mean-adjust data in array and force missing data to zero
- \param cc Array of values to mean-adjust
- \param n Number of values in array
- \param pmean Output parameter for returning the mean
+ \brief Mean-adjust data in array and force missing data to zero
+ \param cc Array of values to mean-adjust
+ \param n Number of values in array
+ \param pmean Output parameter for returning the mean
*/
-
/*! \fn int inpack2(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Load packed genotype file for merge of genotype files (used by getgenos_list)
- \param gname Name of input genotype file
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of SNPs in snpm
- \param numind Number of individuals in indiv
+ \brief Load packed genotype file for merge of genotype files (used by getgenos_list)
+ \param gname Name of input genotype file
+ \param snpm Array of SNP data
+ \param indiv Array of individual data
+ \param numsnps Number of SNPs in snpm
+ \param numind Number of individuals in indiv
*/
-
/*! \fn void getgenos_list(char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
- int numindivs, int nignore)
- \brief (Undocumented feature) Read in data from all genotype files in a list
- \param genotypelist File with names of genotype files in it
- \param snpmarkers Array of SNP data
- \param indivmarkers Array of individual data
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore (not used)
+ int numindivs, int nignore)
+ \brief (Undocumented feature) Read in data from all genotype files in a list
+ \param genotypelist File with names of genotype files in it
+ \param snpmarkers Array of SNP data
+ \param indivmarkers Array of individual data
+ \param numsnps Number of SNPs in snpmarkers
+ \param numindivs Number of individuals in indivmarkers
+ \param nignore (not used)
*/
-
/*! \fn int str2chrom(char *ss)
- \brief Encode string representation of chromosome to digit equivalent
+ \brief Encode string representation of chromosome to digit equivalent
*/
-
/*! \fn int snprawindex(SNPDATA **snpraw, int nreal, char *sname)
- \brief Return index of SNP with name sname in array snpraw
+ \brief Return index of SNP with name sname in array snpraw
*/
-
/*! \fn void freesnprawindex()
- \brief Free hash table used to look up indices in snpraw
+ \brief Free hash table used to look up indices in snpraw
*/
/*! \fn void cntpops(int *count, Indiv **indm, int numindivs, char **eglist, int numeg)
- \brief Count number of samples in each population
- \param count Array in which to store counts
- \param indm Array of individual data
- \param numindivs Number of individuals in indm
- \param eglist Array of population names
- \param numeg Number of individuals in eglist
+ \brief Count number of samples in each population
+ \param count Array in which to store counts
+ \param indm Array of individual data
+ \param numindivs Number of individuals in indm
+ \param eglist Array of population names
+ \param numeg Number of individuals in eglist
*/
/*! \fn int genoopenit(genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m, int numsnp2,
- int numindiv2, int nignore)
- \brief Not used in EIGENSOFT (obsolete?)
+ int numindiv2, int nignore)
+ \brief Not used in EIGENSOFT (obsolete?)
*/
/*! \fn int genoreadit(genofile *gfile, SNP **pcupt)
- \brief Not used in EIGENSOFT (obsolete?)
+ \brief Not used in EIGENSOFT (obsolete?)
*/
/*! \fn int putped(int num)
- \brief Store array snpord in snporda
- \param num Index in snporda in which to store copy of array
+ \brief Store array snpord in snporda
+ \param num Index in snporda in which to store copy of array
*/
/*! \fn void getped(int num)
- \brief Copy array snpord from snporda
- \param num Index in snporda from which to copy array
+ \brief Copy array snpord from snporda
+ \param num Index in snporda from which to copy array
*/
/*! \fn int getweights(char *fname, SNP **snpm, int numsnps)
- \brief Read SNP weights from input file
- \param fname Weight file name
- \param snpm Array of SNP data
- \param numsnps Number of SNPs in snpm
- \return Number of weights set
+ \brief Read SNP weights from input file
+ \param fname Weight file name
+ \param snpm Array of SNP data
+ \param numsnps Number of SNPs in snpm
+ \return Number of weights set
*/
-
-void setchr(int mode)
+void
+setchr (int mode)
{
- chrmode = mode ;
+ chrmode = mode;
}
-void setchimpmode(int mode)
+void
+setchimpmode (int mode)
{
- chimpmode = mode ;
+ chimpmode = mode;
}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/mergeit.c b/src/mergeit.c
index 8b70f82..e5ba812 100644
--- a/src/mergeit.c
+++ b/src/mergeit.c
@@ -26,47 +26,47 @@
// malexhet added
// polarmode added both input files assumed polarized
-char *trashdir = "/var/tmp" ;
-extern int verbose ;
-int qtmode = NO ;
-Indiv **indm1, **indm2 ;
-SNP **snpm1, **snpm2 ;
-int nums1, nums2 ;
-int numi1, numi2 ;
-
-char *snp1 = NULL ;
-char *ind1 = NULL ;
-char *geno1 = NULL ;
-
-char *snp2 = NULL ;
-char *ind2 = NULL ;
-char *geno2 = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *badsnpname = NULL ;
-
-int packout = -1 ;
-int tersem = YES ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-char *omode = "packedancestrymap" ;
-extern int packmode ;
-extern long packlen ;
-
-int ogmode = NO ;
-int docheck = YES ;
-int strandcheck = YES ;
-int polarmode = NO ;
-int phasedmode = NO ;
-int allowdups = NO ;
-
-int xchrom = -1 ;
-int lopos = -999999999 ;
-int hipos = 999999999 ;
-int minchrom = 1 ;
-int maxchrom = 97 ;
+char *trashdir = "/var/tmp";
+extern int verbose;
+int qtmode = NO;
+Indiv **indm1, **indm2;
+SNP **snpm1, **snpm2;
+int nums1, nums2;
+int numi1, numi2;
+
+char *snp1 = NULL;
+char *ind1 = NULL;
+char *geno1 = NULL;
+
+char *snp2 = NULL;
+char *ind2 = NULL;
+char *geno2 = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *badsnpname = NULL;
+
+int packout = -1;
+int tersem = YES;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+char *omode = "packedancestrymap";
+extern int packmode;
+extern long packlen;
+
+int ogmode = NO;
+int docheck = YES;
+int strandcheck = YES;
+int polarmode = NO;
+int phasedmode = NO;
+int allowdups = NO;
+
+int xchrom = -1;
+int lopos = -999999999;
+int hipos = 999999999;
+int minchrom = 1;
+int maxchrom = 97;
/**
docheck: YES allele flipping check
@@ -74,392 +74,448 @@ int maxchrom = 97 ;
strandcheck: (default YES) if NO then alleles are assumed on same strand
allowdups: YES (second set of data ... dup individuals are killed otherwise fatal error
rewrote mergeit() removed call to rmindivs (bug??)
-*/
+ */
+
+char unknowngender = 'U';
+
+void
+setomode (enum outputmodetype *outmode, char *omode);
+void
+readcommands (int argc, char **argv);
+void
+outfiles (char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
+ int numsnps, int numind, int packem, int ogmode);
+int
+checkmatch (SNP *cupt1, SNP *cupt2);
+
+int
+mergeit (SNP **snpm1, SNP **snpm2, Indiv ***pindm1, Indiv **indm2, int nums1,
+ int nums2, int numi1, int numi2);
+
+int
+main (int argc, char **argv)
+{
+ SNP **snpmarkers;
+ Indiv **indivmarkers;
+ int numsnps, numindivs;
+ unsigned char *packg1, *packg2;
+
+ int **snppos;
+ int *snpindx;
+ int lsnplist, lindlist, numeg;
+ int i, j;
+ SNP *cupt, *cupt1, *cupt2, *cupt3;
+ Indiv *indx;
+
+ int ch1, ch2;
+ int fmnum, lmnum;
+ int num, n1, n2;
+ int nkill = 0;
+ int t, k, x;
+
+ int nignore, numrisks = 1;
+
+ char **genolist;
+ int numgenolist;
+ int maxmiss;
+ int sorder[2];
+
+ tersem = YES; // no snp counts
+
+ readcommands (argc, argv);
+
+ setomode (&outputmode, omode);
+ packmode = YES;
+ settersemode (tersem);
+ if (phasedmode)
+ malexhet = YES;
+ if (polarmode)
+ {
+ strandcheck = NO;
+ printf ("polarmode set!\n");
+ }
-char unknowngender = 'U' ;
+ nums1 = getsnps (snp1, &snpm1, 0.0, NULL, &nignore, numrisks);
-void setomode(enum outputmodetype *outmode, char *omode) ;
-void readcommands(int argc, char **argv) ;
-void outfiles(char *snpname, char *indname, char *gname, SNP **snpm,
- Indiv **indiv, int numsnps, int numind, int packem, int ogmode) ;
-int checkmatch(SNP *cupt1, SNP *cupt2) ;
+ sorder[0] = getsnpordered ();
+ putped (1);
+ freeped ();
-int
-mergeit(SNP **snpm1, SNP **snpm2, Indiv ***pindm1, Indiv **indm2,
- int nums1, int nums2, int numi1, int numi2) ;
+ sorder[1] = getsnpordered ();
+ nums2 = getsnps (snp2, &snpm2, 0.0, NULL, &nignore, numrisks);
+ putped (2);
+ freeped ();
-int main(int argc, char **argv)
-{
- SNP **snpmarkers ;
- Indiv **indivmarkers ;
- int numsnps, numindivs ;
- unsigned char *packg1, *packg2 ;
-
- int **snppos ;
- int *snpindx ;
- int lsnplist, lindlist, numeg ;
- int i,j;
- SNP *cupt, *cupt1, *cupt2, *cupt3 ;
- Indiv *indx ;
-
- int ch1, ch2 ;
- int fmnum , lmnum ;
- int num, n1, n2 ;
- int nkill = 0 ;
- int t, k, x ;
-
- int nignore, numrisks = 1 ;
-
- char **genolist ;
- int numgenolist ;
- int maxmiss ;
- int sorder[2] ;
-
- tersem = YES ; // no snp counts
-
- readcommands(argc, argv) ;
-
- setomode(&outputmode, omode) ;
- packmode = YES ;
- settersemode(tersem) ;
- if (phasedmode) malexhet = YES ;
- if (polarmode) {
- strandcheck = NO ;
- printf("polarmode set!\n") ;
- }
-
- nums1 =
- getsnps(snp1, &snpm1, 0.0, NULL, &nignore, numrisks) ;
-
- sorder[0] = getsnpordered() ;
- putped(1) ;
- freeped() ;
-
- sorder[1] = getsnpordered() ;
- nums2 =
- getsnps(snp2, &snpm2, 0.0, NULL, &nignore, numrisks) ;
-
- putped(2) ;
- freeped() ;
-
- for (x=0; x<nums1; ++x) {
- cupt1 = snpm1[x] ;
- cupt1 -> tagnumber = -1 ;
- }
- for (x=0; x<nums2; ++x) {
- cupt2 = snpm2[x] ;
- t = x %1000 ;
+ for (x = 0; x < nums1; ++x)
+ {
+ cupt1 = snpm1[x];
+ cupt1->tagnumber = -1;
+ }
+ for (x = 0; x < nums2; ++x)
+ {
+ cupt2 = snpm2[x];
+ t = x % 1000;
// if (t==0) printf("zz %d %d\n", x, nums2) ;
- k = snpindex(snpm1, nums1, cupt2 -> ID) ;
- if (k<0) {
- cupt2 -> ignore = YES ;
- continue ;
- }
- cupt1 = snpm1[k] ;
- cupt1 -> tagnumber = x ;
- t = checkmatch(cupt1, cupt2) ;
- if (t==1) continue ;
- if (t==2) {
- cupt2 -> isrfake = YES ;
- continue ;
- }
- if (t<0) {
- cupt1 -> ignore = cupt2 -> ignore = YES ;
- continue ;
- }
- printf("allele funny: %s", cupt1 -> ID) ;
- printalleles(cupt1, stdout) ;
- printalleles(cupt2, stdout) ;
- printnl() ;
- cupt1 -> ignore = cupt2 -> ignore = YES ;
- continue ;
- }
- freesnpindex() ;
- numi1 = getindivs(ind1, &indm1) ;
- numi2 = getindivs(ind2, &indm2) ;
-
- for (x=0; x<numi2; ++x) {
- k = indindex(indm1, numi1, indm2[x] -> ID) ;
- if ((k>=0) && (allowdups == NO)) fatalx("dup ind: %s\n", indm2[x] -> ID) ; // fix later?
- if ((k>=0) && (allowdups) && (indm1[k] -> ignore == NO)) indm2[x] -> ignore = YES ;
- }
-
-
- setgenotypename(&geno1, ind1) ;
- getped(1) ;
- putsnpordered(sorder[0]) ;
- getgenos(geno1, snpm1, indm1,
- nums1, numi1, nignore) ;
-
- packg1 = (unsigned char *) getpackgenos() ;
- clearpackgenos() ;
-
- setgenotypename(&geno2, ind2) ;
- getped(2) ;
- putsnpordered(sorder[1]) ;
- getgenos(geno2, snpm2, indm2,
- nums2, numi2, nignore) ;
-
-/**
- numi1 = rmindivs(snpm1, nums1, indm1, numi1) ;
- numi2 = rmindivs(snpm2, nums2, indm2, numi2) ;
-*/
-
- packg2 = (unsigned char *) getpackgenos() ;
- numindivs = mergeit(snpm1, snpm2, &indm1, indm2, nums1, nums2, numi1, numi2) ;
-
- snpmarkers = snpm1 ;
- numsnps = nums1 ;
- indivmarkers = indm1 ;
-
- free(packg1) ;
- free(packg2) ;
+ k = snpindex (snpm1, nums1, cupt2->ID);
+ if (k < 0)
+ {
+ cupt2->ignore = YES;
+ continue;
+ }
+ cupt1 = snpm1[k];
+ cupt1->tagnumber = x;
+ t = checkmatch (cupt1, cupt2);
+ if (t == 1)
+ continue;
+ if (t == 2)
+ {
+ cupt2->isrfake = YES;
+ continue;
+ }
+ if (t < 0)
+ {
+ cupt1->ignore = cupt2->ignore = YES;
+ continue;
+ }
+ printf ("allele funny: %s", cupt1->ID);
+ printalleles (cupt1, stdout);
+ printalleles (cupt2, stdout);
+ printnl ();
+ cupt1->ignore = cupt2->ignore = YES;
+ continue;
+ }
+ freesnpindex ();
+ numi1 = getindivs (ind1, &indm1);
+ numi2 = getindivs (ind2, &indm2);
+
+ for (x = 0; x < numi2; ++x)
+ {
+ k = indindex (indm1, numi1, indm2[x]->ID);
+ if ((k >= 0) && (allowdups == NO))
+ fatalx ("dup ind: %s\n", indm2[x]->ID); // fix later?
+ if ((k >= 0) && (allowdups) && (indm1[k]->ignore == NO))
+ indm2[x]->ignore = YES;
+ }
-// numsnps = rmsnps(snpmarkers, numsnps, NULL) ;
+ setgenotypename (&geno1, ind1);
+ getped (1);
+ putsnpordered (sorder[0]);
+ getgenos (geno1, snpm1, indm1, nums1, numi1, nignore);
- printf("numsnps: %d numindivs: %d\n", numsnps, numindivs) ;
+ packg1 = (unsigned char *) getpackgenos ();
+ clearpackgenos ();
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
+ setgenotypename (&geno2, ind2);
+ getped (2);
+ putsnpordered (sorder[1]);
+ getgenos (geno2, snpm2, indm2, nums2, numi2, nignore);
- printf("##end of mergeit run\n") ;
- return 0 ;
-}
-int checkmatch(SNP *cupt1, SNP *cupt2)
-{
+ /**
+ numi1 = rmindivs(snpm1, nums1, indm1, numi1) ;
+ numi2 = rmindivs(snpm2, nums2, indm2, numi2) ;
+ */
- char a1, a2, b1 , b2 ;
+ packg2 = (unsigned char *) getpackgenos ();
+ numindivs = mergeit (snpm1, snpm2, &indm1, indm2, nums1, nums2, numi1, numi2);
- if (docheck == NO) return 1 ;
- if (cupt1 -> alleles == NULL) return -1 ;
- if (cupt2 -> alleles == NULL) return -1 ;
+ snpmarkers = snpm1;
+ numsnps = nums1;
+ indivmarkers = indm1;
- a1 = cupt1 -> alleles[0] ;
- a2 = cupt1 -> alleles[1] ;
+ free (packg1);
+ free (packg2);
- b1 = cupt2 -> alleles[0] ;
- b2 = cupt2 -> alleles[1] ;
+// numsnps = rmsnps(snpmarkers, numsnps, NULL) ;
- a1 = toupper(a1) ;
- a2 = toupper(a2) ;
+ printf ("numsnps: %d numindivs: %d\n", numsnps, numindivs);
- b1 = toupper(b1) ;
- b2 = toupper(b2) ;
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
- if ((a1 == 'X') && (a2 == 'X') && (strandcheck)) return -1 ; // flipcheck impossible
+ printf ("##end of mergeit run\n");
+ return 0;
+}
+int
+checkmatch (SNP *cupt1, SNP *cupt2)
+{
- if (strandcheck) {
+ char a1, a2, b1, b2;
+
+ if (docheck == NO)
+ return 1;
+ if (cupt1->alleles == NULL)
+ return -1;
+ if (cupt2->alleles == NULL)
+ return -1;
+
+ a1 = cupt1->alleles[0];
+ a2 = cupt1->alleles[1];
+
+ b1 = cupt2->alleles[0];
+ b2 = cupt2->alleles[1];
+
+ a1 = toupper(a1);
+ a2 = toupper(a2);
+
+ b1 = toupper(b1);
+ b2 = toupper(b2);
+
+ if ((a1 == 'X') && (a2 == 'X') && (strandcheck))
+ return -1; // flipcheck impossible
+
+ if (strandcheck)
+ {
+
+ if ((a1 == 'A') && (a2 == 'T'))
+ return -1;
+ if ((a1 == 'T') && (a2 == 'A'))
+ return -1;
+ if ((a1 == 'C') && (a2 == 'G'))
+ return -1;
+ if ((a1 == 'G') && (a2 == 'C'))
+ return -1;
+
+ if ((b1 == 'A') && (b2 == 'T'))
+ return -1;
+ if ((b1 == 'T') && (b2 == 'A'))
+ return -1;
+ if ((b1 == 'C') && (b2 == 'G'))
+ return -1;
+ if ((b1 == 'G') && (b2 == 'C'))
+ return -1;
+ }
- if ((a1 == 'A') && (a2 == 'T')) return -1 ;
- if ((a1 == 'T') && (a2 == 'A')) return -1 ;
- if ((a1 == 'C') && (a2 == 'G')) return -1 ;
- if ((a1 == 'G') && (a2 == 'C')) return -1 ;
+ if (polarmode)
+ {
+ if ((a1 == b1) && (a2 == b2))
+ return 1;
+ if ((a1 == b1) && (b2 == 'X'))
+ return 1;
+ b1 = compbase (b1);
+ b2 = compbase (b2);
+ if ((a1 == b1) && (a2 == b2))
+ return 1;
+ return -1;
+ }
- if ((b1 == 'A') && (b2 == 'T')) return -1 ;
- if ((b1 == 'T') && (b2 == 'A')) return -1 ;
- if ((b1 == 'C') && (b2 == 'G')) return -1 ;
- if ((b1 == 'G') && (b2 == 'C')) return -1 ;
- }
+ if ((a1 == b1) && (a2 == 'X'))
+ {
+ cupt1->alleles[1] = b2;
+ return 1;
+ }
- if (polarmode) {
- if ((a1==b1) && (a2==b2)) return 1 ;
- if ((a1==b1) && (b2=='X')) return 1 ;
- b1 = compbase(b1) ;
- b2 = compbase(b2) ;
- if ((a1==b1) && (a2==b2)) return 1 ;
- return -1 ;
- }
+ if ((a1 == b2) && (a2 == 'X'))
+ {
+ cupt1->alleles[1] = b1;
+ return 2;
+ }
- if ((a1 == b1) && (a2 == 'X')) {
- cupt1 -> alleles[1] = b2 ;
- return 1 ;
- }
+ if ((a1 == b1) && (a2 == b2))
+ return 1;
+ if ((a1 == b2) && (a2 == b1))
+ return 2;
- if ((a1 == b2) && (a2 == 'X')) {
- cupt1 -> alleles[1] = b1 ;
- return 2 ;
- }
+ if ((a1 == b1) && (b2 == 'X'))
+ return 1;
+ if ((a2 == b1) && (b2 == 'X'))
+ return 2;
+ if (strandcheck == NO)
+ return 0;
- if ((a1 == b1) && (a2 == b2)) return 1 ;
- if ((a1 == b2) && (a2 == b1)) return 2 ;
+ b1 = compbase (b1);
+ b2 = compbase (b2);
- if ((a1 == b1) && (b2 =='X')) return 1 ;
- if ((a2 == b1) && (b2 =='X')) return 2 ;
+ if ((a1 == b1) && (a2 == 'X'))
+ {
+ cupt1->alleles[1] = b2;
+ return 1;
+ }
+
+ if ((a1 == b2) && (a2 == 'X'))
+ {
+ cupt1->alleles[1] = b1;
+ return 2;
+ }
- if (strandcheck == NO) return 0 ;
+ if ((a1 == b1) && (a2 == b2))
+ return 1;
+ if ((a1 == b2) && (a2 == b1))
+ return 2;
- b1 = compbase(b1) ;
- b2 = compbase(b2) ;
+ if ((a1 == b1) && (b2 == 'X'))
+ return 1;
+ if ((a2 == b1) && (b2 == 'X'))
+ return 2;
- if ((a1 == b1) && (a2 == 'X')) {
- cupt1 -> alleles[1] = b2 ;
- return 1 ;
- }
+ return 0;
- if ((a1 == b2) && (a2 == 'X')) {
- cupt1 -> alleles[1] = b1 ;
- return 2 ;
- }
+}
- if ((a1 == b1) && (a2 == b2)) return 1 ;
- if ((a1 == b2) && (a2 == b1)) return 2 ;
+void
+readcommands (int argc, char **argv)
- if ((a1 == b1) && (b2 =='X')) return 1 ;
- if ((a2 == b1) && (b2 =='X')) return 2 ;
+{
+ int i, haploid = 0;
+ char *parname = NULL;
+ phandle *ph;
+ char str[5000];
+ char *tempname;
+ int n;
+
+ while ((i = getopt (argc, argv, "p:vVf")) != -1)
+ {
+
+ switch (i)
+ {
+
+ case 'p':
+ parname = strdup (optarg);
+ break;
+
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
+
+ case 'V':
+ verbose = YES;
+ break;
+
+ case 'f':
+ phasedmode = YES;
+ break;
+
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
- return 0 ;
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
-}
+ getstring (ph, "geno1:", &geno1);
+ getstring (ph, "snp1:", &snp1);
+ getstring (ph, "ind1:", &ind1);
-void readcommands(int argc, char **argv)
+ getstring (ph, "geno2:", &geno2);
+ getstring (ph, "snp2:", &snp2);
+ getstring (ph, "ind2:", &ind2);
-{
- int i,haploid=0;
- char *parname = NULL ;
- phandle *ph ;
- char str[5000] ;
- char *tempname ;
- int n ;
-
- while ((i = getopt (argc, argv, "p:vVf")) != -1) {
-
- switch (i)
- {
-
- case 'p':
- parname = strdup(optarg) ;
- break;
-
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
-
- case 'V':
- verbose = YES ;
- break;
-
- case 'f':
- phasedmode = YES ;
- break;
-
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
-
-
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "geno1:", &geno1) ;
- getstring(ph, "snp1:", &snp1) ;
- getstring(ph, "ind1:", &ind1) ;
-
- getstring(ph, "geno2:", &geno2) ;
- getstring(ph, "snp2:", &snp2) ;
- getstring(ph, "ind2:", &ind2) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "outputformat:", &omode) ;
-
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
-
- getint(ph, "docheck:", &docheck) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "strandcheck:", &strandcheck) ;
- getint(ph, "phasedmode:", &phasedmode) ;
- getint(ph, "numchrom:", &numchrom) ;
- getint(ph, "allowdups:", &allowdups) ;
- getint(ph, "polarmode:", &polarmode) ;
-
-
- writepars(ph) ;
- closepars(ph) ;
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "outputformat:", &omode);
+
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+
+ getint (ph, "docheck:", &docheck);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "strandcheck:", &strandcheck);
+ getint (ph, "phasedmode:", &phasedmode);
+ getint (ph, "numchrom:", &numchrom);
+ getint (ph, "allowdups:", &allowdups);
+ getint (ph, "polarmode:", &polarmode);
+
+ writepars (ph);
+ closepars (ph);
}
-int
-mergeit(SNP **snpm1, SNP **snpm2, Indiv ***pindm1, Indiv **indm2,
- int nums1, int nums2, int numi1, int numi2)
+int
+mergeit (SNP **snpm1, SNP **snpm2, Indiv ***pindm1, Indiv **indm2, int nums1,
+ int nums2, int numi1, int numi2)
{
- SNP *cupt1, *cupt2 ;
- int k, x, g, t, tt ;
- double y ;
- long rlen ;
- static unsigned char *packg ;
- unsigned char *buff ;
- Indiv **indm1 ;
- static Indiv **indivmarkers ;
- int numindivs, numsnps ;
- int newnumi1, newnumi2 ;
-
- indm1 = *pindm1 ;
- numindivs = numi1 + numi2 ;
- numsnps = nums1 ;
- ZALLOC(indivmarkers, numindivs, Indiv *) ;
-
- t = 0 ;
- for (x=0; x<numi1; ++x) {
- if (indm1[x]-> ignore) continue ;
- indivmarkers[t] = indm1[x] ;
- ++t ;
- }
- newnumi1 = t ;
- for (x=0; x<numi2; ++x) {
- if (indm2[x]-> ignore) continue ;
- indivmarkers[t] = indm2[x] ;
- ++t ;
- }
- newnumi2 = t - newnumi1 ;
- numindivs = t ;
+ SNP *cupt1, *cupt2;
+ int k, x, g, t, tt;
+ double y;
+ long rlen;
+ static unsigned char *packg;
+ unsigned char *buff;
+ Indiv **indm1;
+ static Indiv **indivmarkers;
+ int numindivs, numsnps;
+ int newnumi1, newnumi2;
+
+ indm1 = *pindm1;
+ numindivs = numi1 + numi2;
+ numsnps = nums1;
+ ZALLOC(indivmarkers, numindivs, Indiv *);
+
+ t = 0;
+ for (x = 0; x < numi1; ++x)
+ {
+ if (indm1[x]->ignore)
+ continue;
+ indivmarkers[t] = indm1[x];
+ ++t;
+ }
+ newnumi1 = t;
+ for (x = 0; x < numi2; ++x)
+ {
+ if (indm2[x]->ignore)
+ continue;
+ indivmarkers[t] = indm2[x];
+ ++t;
+ }
+ newnumi2 = t - newnumi1;
+ numindivs = t;
// we don't bother with a destructor here. Sloppy code
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- packlen = numsnps*rlen ;
- ZALLOC(packg, packlen, unsigned char) ;
- clearepath(packg) ;
+ y = (double) (numindivs * 2) / (8 * (double) sizeof(char));
+ rlen = nnint (ceil (y));
+ rlen = MAX(rlen, 48);
+ packlen = numsnps * rlen;
+ ZALLOC(packg, packlen, unsigned char);
+ clearepath (packg);
// wipe to invalid
- buff = packg ;
- for (k=0; k<nums1; k++) {
- cupt1 = snpm1[k] ;
- x = cupt1 -> tagnumber ;
- if (x < 0 ) cupt1 -> ignore = YES ;
- if (cupt1 -> ignore) continue ;
- cupt2 = snpm2[x] ;
- if (cupt2 -> isrfake) {
- if (phasedmode == NO) flipalleles(cupt2) ;
- if (phasedmode == YES) flipalleles_phased(cupt2) ;
- }
- tt = 0 ;
- for (t=0; t<numi1; ++t) {
- if (indm1[t]-> ignore) continue ;
- g = getgtypes(cupt1, t) ;
- if (g<0) g = 3 ;
- wbuff((unsigned char *)buff, tt, g) ;
- ++tt ;
- }
- for (t=0; t<numi2; ++t) {
- if (indm2[t]-> ignore) continue ;
- g = getgtypes(cupt2, t) ;
- if (g<0) g = 3 ;
- wbuff((unsigned char *)buff, tt, g) ;
- ++tt ;
+ buff = packg;
+ for (k = 0; k < nums1; k++)
+ {
+ cupt1 = snpm1[k];
+ x = cupt1->tagnumber;
+ if (x < 0)
+ cupt1->ignore = YES;
+ if (cupt1->ignore)
+ continue;
+ cupt2 = snpm2[x];
+ if (cupt2->isrfake)
+ {
+ if (phasedmode == NO)
+ flipalleles (cupt2);
+ if (phasedmode == YES)
+ flipalleles_phased (cupt2);
+ }
+ tt = 0;
+ for (t = 0; t < numi1; ++t)
+ {
+ if (indm1[t]->ignore)
+ continue;
+ g = getgtypes (cupt1, t);
+ if (g < 0)
+ g = 3;
+ wbuff ((unsigned char *) buff, tt, g);
+ ++tt;
+ }
+ for (t = 0; t < numi2; ++t)
+ {
+ if (indm2[t]->ignore)
+ continue;
+ g = getgtypes (cupt2, t);
+ if (g < 0)
+ g = 3;
+ wbuff ((unsigned char *) buff, tt, g);
+ ++tt;
+ }
+ cupt1->ngtypes = numindivs;
+ cupt1->pbuff = (char *) buff;
+ buff += rlen;
}
- cupt1 -> ngtypes = numindivs ;
- cupt1 -> pbuff = (char *) buff ;
- buff += rlen ;
- }
- *pindm1 = indivmarkers ;
- return numindivs ;
+ *pindm1 = indivmarkers;
+ return numindivs;
}
diff --git a/src/mmakefile b/src/mmakefile
deleted file mode 100644
index bc37483..0000000
--- a/src/mmakefile
+++ /dev/null
@@ -1,99 +0,0 @@
-CC = gcc
-
-# ----- note that the -g debug info flag has been removed from CFLAGS, and
-# ----- replaced with -O2 optimization. Feel free to reverse this change
-# ----- before redistributing this publicly.
-CFLAGS = -I../include ## -O2 -Wall
-LDFLAGS = -I../include -pthread
-
-ND=nicksrc
-ED=eigensrc
-NLIB = $(ND)/libnick.a
-MATHLIB = -lm
-
-LAPACK = -llapack
-ATLAS_LAPACK = -L/usr/lib64/atlas -llapack -lf77blas -lcblas -latlas
-
-# ----- OS X fix
-UNAME := $(shell uname)
-ifeq ($(UNAME), Darwin)
-LAPACK = -framework Accelerate
-ATLAS_LAPACK = -framework Accelerate
-endif
-
-EXE = convertf mergeit smartpca smartrel pcatoy smarteigenstrat twstats eigenstrat
-
-TWTAB = \"../src/smarttables/twtable\"
-
-NLIBOBJS = $(ND)/gauss.o $(ND)/gds.o $(ND)/getpars.o $(ND)/linsubs.o $(ND)/sortit.o $(ND)/statsubs.o \
- $(ND)/strsubs.o $(ND)/vsubs.o $(ND)/xsearch.o
-
-
-# ----- default
-%:%.o
- $(CC) $(LDFLAGS) $^ -o $@ $(MATHLIB)
-
-%.o: %.c
- $(CC) -c $(CFLAGS) -o $@ $<
-
-
-.PHONY: all clean clobber install
-
-
-
-# ----- define TW table in statsubs
-$(ND)/statsubs.o: $(ND)/statsubs.c
- $(CC) -c $(CFLAGS) -DTWTAB=$(TWTAB) -o $@ $<
-
-# ----- build nicksrc/libnick.a
-$(NLIB): $(NLIBOBJS)
- ar -r $(NLIB) $(NLIBOBJS)
-
-
-
-
-
-# ----- build EIGENSOFT
-convertf: convertf.o mcio.o egsubs.o admutils.o h2d.o $(ED)/exclude.o $(NLIB)
- $(CC) $(LDFLAGS) $^ -o $@ $(MATHLIB)
-
-mergeit: mergeit.o mcio.o admutils.o $(NLIB)
- $(CC) $(LDFLAGS) $^ -o $@ $(MATHLIB)
-
-pcatoy: eigensrc/pcatoy.o eigensrc/eigsubs.o eigensrc/eigx.o $(NLIB)
- $(CC) $(LDFLAGS) -o $@ $(LAPACK) $^ $(MATHLIB)
-
-smartpca: $(ED)/smartpca.o twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o \
- $(ED)/eigsubs.o \
- $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o $(NLIB)
- $(CC) $(LDFLAGS) -o $@ $(LAPACK) $^ $(MATHLIB)
-
-smartrel: $(ED)/smartrel.o twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o \
- $(ED)/eigsubs.o $(ED)/eigx.o $(NLIB)
- $(CC) $(LDFLAGS) -o $@ $(LAPACK) $^ $(MATHLIB)
-
-smarteigenstrat: $(ED)/smarteigenstrat.o mcio.o admutils.o $(NLIB)
- $(CC) $(LDFLAGS) -o $@ $(LAPACK) $^ $(MATHLIB)
-
-twstats: $(ED)/twstats.o $(NLIB)
- $(CC) $(LDFLAGS) $^ -o $@ $(MATHLIB)
-
-eigenstrat: $(ED)/eigenstrat.o
- $(CC) $(LDFLAGS) $^ -o $@ $(MATHLIB)
-
-
-
-
-# ----- phony targets
-all: $(EXE)
-
-install: all
- mv $(EXE) ../bin
-
-clobber:
- rm -f *.o core core.* $(ND)/*.o $(ND)/*.a $(ED)/*.o
- rm -f $(EXE)
- cd ../bin/ ; rm -f $(EXE) ; cd ../src
-
-clean:
- rm -f *.o core core.* *.o
diff --git a/src/nicksrc/LICENSE.txt b/src/nicksrc/LICENSE.txt
new file mode 100644
index 0000000..fb53d21
--- /dev/null
+++ b/src/nicksrc/LICENSE.txt
@@ -0,0 +1,32 @@
+Copyright (c) 2006-2016, Broad Institute, Inc. and Harvard Medical School
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+*
+ Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+
+*
+ Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+
+*
+ Neither the name Broad Institute, Inc. Harvard University, nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE
diff --git a/src/nicksrc/Makefile b/src/nicksrc/Makefile
index 764cc8f..00d9af5 100644
--- a/src/nicksrc/Makefile
+++ b/src/nicksrc/Makefile
@@ -8,10 +8,8 @@ ifeq ($(PROFILING), 1)
CFLAGS += -pg # enable profiling
endif
-TWTAB = '"../smarttables/twtable"'
-
NLIB = libnick.a
-NLIBOBJS = gauss.o gds.o getpars.o linsubs.o sortit.o statsubs.o strsubs.o vsubs.o xsearch.o
+NLIBOBJS = gauss.o gds.o getpars.o linsubs.o sortit.o statsubs.o strsubs.o vsubs.o xsearch.o twtable.o
.PHONY: all clean
@@ -23,5 +21,3 @@ clean:
# ----- build nicksrc/libnick.a
$(NLIB): $(NLIBOBJS)
ar -r $@ $^
-
-statsubs.o: CFLAGS += -DTWTAB=$(TWTAB)
diff --git a/src/nicksrc/gauss.c b/src/nicksrc/gauss.c
index 3b3e319..f39d411 100644
--- a/src/nicksrc/gauss.c
+++ b/src/nicksrc/gauss.c
@@ -1,39 +1,44 @@
#include "ranmath.h"
-double gauss()
+double
+gauss ()
{
-/**
- Numer alg. in C pp 289 ff
-*/
-
-static int iset=0 ;
-static double gset ;
-double v1,v2,rsq,fac ;
-
-if (iset==1) {
- iset=0 ;
- return gset ;
-}
-
- do {
- v1=2.0*DRAND2()-1.0 ;
- v2=2.0*DRAND2()-1.0 ;
- rsq = v1*v1 + v2*v2 ;
- } while (rsq >= 1.0 || rsq == 0.0 ) ;
-
- fac=sqrt(-2.0*log(rsq)/rsq) ;
- gset=v1*fac ;
- iset=1 ;
- return v2*fac ;
+ /**
+ Numer alg. in C pp 289 ff
+ */
+
+ static int iset = 0;
+ static double gset;
+ double v1, v2, rsq, fac;
+
+ if (iset == 1)
+ {
+ iset = 0;
+ return gset;
+ }
+
+ do
+ {
+ v1 = 2.0 * DRAND2() - 1.0;
+ v2 = 2.0 * DRAND2() - 1.0;
+ rsq = v1 * v1 + v2 * v2;
+ }
+ while (rsq >= 1.0 || rsq == 0.0);
+
+ fac = sqrt (-2.0 * log (rsq) / rsq);
+ gset = v1 * fac;
+ iset = 1;
+ return v2 * fac;
}
-void gaussa(double *a, int n)
+void
+gaussa (double *a, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = gauss() ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = gauss ();
}
diff --git a/src/nicksrc/gds.c b/src/nicksrc/gds.c
index bde2c60..ffa6f84 100644
--- a/src/nicksrc/gds.c
+++ b/src/nicksrc/gds.c
@@ -11,667 +11,782 @@
#include <limits.h>
#include <float.h>
-static int ranb1 (int n, double p) ;
-static double ranpoiss1(double xm) ;
+static int
+ranb1 (int n, double p);
+static double
+ranpoiss1 (double xm);
-double gds( double a)
+double
+gds (double a)
{
- return rangam(a) ;
+ return rangam (a);
}
-static double
-randev1(double a)
+static double
+randev1 (double a)
{
/**
Random gamma deviate: a>=1
GBEST algorithm (D.J. BEST: Appl. Stat. 29 p 181 1978
- */
- double x, d, e, c, g, f, r1, r2;
+ */
+ double x, d, e, c, g, f, r1, r2;
e = a - 1.0;
c = 3.0 * a - 0.75;
-
- for (;;) {
- r1 = DRAND2();
- g = r1 - (r1 * r1);
- if (g <= 0.0)
- continue;
- f = (r1 - 0.5) * sqrt(c / g);
- x = e + f;
- if (x <= 0.0)
- continue;
- r2 = DRAND2();
- d = 64.0 * r2 * r2 * g * g * g;
- if ((d >= 1.0 - 2.0 * f * f / x) && (log(d) >= 2.0 * (e * log(x / e) - f)))
- continue;
- return (x);
- }
+ for (;;)
+ {
+ r1 = DRAND2();
+ g = r1 - (r1 * r1);
+ if (g <= 0.0)
+ continue;
+ f = (r1 - 0.5) * sqrt (c / g);
+ x = e + f;
+ if (x <= 0.0)
+ continue;
+ r2 = DRAND2();
+ d = 64.0 * r2 * r2 * g * g * g;
+ if ((d >= 1.0 - 2.0 * f * f / x)
+ && (log (d) >= 2.0 * (e * log (x / e) - f)))
+ continue;
+ return (x);
+ }
}
-static double
-randev0(double a)
+static double
+randev0 (double a)
{
/**
algorithm G6: Gamma for a < 1
- */
- double r1, r2, x, w;
+ */
+ double r1, r2, x, w;
double t = 1.0 - a;
- double p = t / (t + a * exp(-t));
+ double p = t / (t + a * exp (-t));
double s = 1.0 / a;
- for (;;) {
- r1 = DRAND2();
- if (r1 <= p) {
- x = t * pow(r1 / p, s);
- w = x;
- } else {
- x = t + log((1.0 - p) / (1.0 - r1));
- w = t * log(x / t);
- }
- r2 = DRAND2();
- if ((1.0 - r2) <= w) {
- if ((1.0 / r2 - 1.0) <= w)
- continue;
- if (-log(r2) <= w)
- continue;
- }
- if (x==0.0) x = 1.0e-20 ;
- return x;
+ for (;;)
+ {
+ r1 = DRAND2();
+ if (r1 <= p)
+ {
+ x = t * pow (r1 / p, s);
+ w = x;
+ }
+ else
+ {
+ x = t + log ((1.0 - p) / (1.0 - r1));
+ w = t * log (x / t);
+ }
+ r2 = DRAND2();
+ if ((1.0 - r2) <= w)
+ {
+ if ((1.0 / r2 - 1.0) <= w)
+ continue;
+ if (-log (r2) <= w)
+ continue;
+ }
+ if (x == 0.0)
+ x = 1.0e-20;
+ return x;
- }
+ }
}
-double
-ranexp( void)
+double
+ranexp (void)
{
/**
exponential mean 1
- */
- double x, t;
+ */
+ double x, t;
t = DRAND2();
- x = -log(1.0 - t);
+ x = -log (1.0 - t);
return x;
}
double
-rangam(double a)
+rangam (double a)
{
/**
generate gamma deviate mean a
- */
-
- if (a<=0.0) {
- fatalx("rangam called with bad param. a: %9.3f\n", a) ;
- }
-
- if (a < 1.0) {
- return( randev0(a));
- }
- if (a == 1.0) {
- return( ranexp());
- }
- return( randev1(a));
+ */
+
+ if (a <= 0.0)
+ {
+ fatalx ("rangam called with bad param. a: %9.3f\n", a);
+ }
+
+ if (a < 1.0)
+ {
+ return (randev0 (a));
+ }
+ if (a == 1.0)
+ {
+ return (ranexp ());
+ }
+ return (randev1 (a));
}
#define PI 3.14159265358979
-double ranpoiss(double xm)
+double
+ranpoiss (double xm)
{
- return poidev(xm) ;
+ return poidev (xm);
}
-double ranpoissx(double xm)
+double
+ranpoissx (double xm)
/* poisson variable conditional on >0 */
{
- double x, t, tc, s, y ;
- int k ;
- if (xm>1.0) {
- for (;;) {
- x = ranpoiss(xm) ;
- if (x>0.5) return x ;
+ double x, t, tc, s, y;
+ int k;
+ if (xm > 1.0)
+ {
+ for (;;)
+ {
+ x = ranpoiss (xm);
+ if (x > 0.5)
+ return x;
+ }
}
- }
- return ranpoiss1(xm) ;
+ return ranpoiss1 (xm);
}
-double poidev(double xm)
+double
+poidev (double xm)
/**
NUM REC pp 293 ff (modified)
-*/
+ */
{
- static double sq,alxm,g,oldm=(-1.0);
- double em,t,y;
-
- if (xm < 12.0) {
- if (xm != oldm) {
- oldm=xm;
- g=exp(-xm);
- }
- em = -1;
- t=1.0;
- do {
- ++em;
- t *= DRAND2();
- } while (t > g);
- } else {
- if (xm != oldm) {
- oldm=xm;
- sq=sqrt(2.0*xm);
- alxm=log(xm);
- g=xm*alxm-lgamma(xm+1.0);
- }
- do {
- do {
- y=tan(PI*DRAND2());
- em=sq*y+xm;
- } while (em < 0.0);
- em=floor(em);
- t=0.9*(1.0+y*y)*exp(em*alxm-lgamma(em+1.0)-g);
- } while (DRAND2() > t);
- }
- return em;
+ static double sq, alxm, g, oldm = (-1.0);
+ double em, t, y;
+
+ if (xm < 12.0)
+ {
+ if (xm != oldm)
+ {
+ oldm = xm;
+ g = exp (-xm);
+ }
+ em = -1;
+ t = 1.0;
+ do
+ {
+ ++em;
+ t *= DRAND2();
+ }
+ while (t > g);
+ }
+ else
+ {
+ if (xm != oldm)
+ {
+ oldm = xm;
+ sq = sqrt (2.0 * xm);
+ alxm = log (xm);
+ g = xm * alxm - lgamma (xm + 1.0);
+ }
+ do
+ {
+ do
+ {
+ y = tan (PI * DRAND2());
+ em = sq * y + xm;
+ }
+ while (em < 0.0);
+ em = floor (em);
+ t = 0.9 * (1.0 + y * y) * exp (em * alxm - lgamma (em + 1.0) - g);
+ }
+ while (DRAND2() > t);
+ }
+ return em;
}
#undef PI
-int randis(double *a, int n)
+int
+randis (double *a, int n)
{
-/* a should be prob dis summing to 1 */
- int i ;
- double t, y ;
- static int nfirst=0 ;
-
- ++nfirst ;
- t = DRAND2() ;
-
- for (i=0; i<n; i++) {
- t -= a[i] ;
- if (t<=0.0) return i ;
- }
- if (nfirst==1) {
- printf("pos t: %15.9f\n",t) ;
- for (i=0; i<n ; i++) {
- printf("zzrand %4d %9.3f\n",i, a[i]) ;
- }
- }
- printf("probable bug (randis)\n") ;
- printmat(a, 1, n) ;
- return n-1 ;
+ /* a should be prob dis summing to 1 */
+ int i;
+ double t, y;
+ static int nfirst = 0;
+
+ ++nfirst;
+ t = DRAND2();
+
+ for (i = 0; i < n; i++)
+ {
+ t -= a[i];
+ if (t <= 0.0)
+ return i;
+ }
+ if (nfirst == 1)
+ {
+ printf ("pos t: %15.9f\n", t);
+ for (i = 0; i < n; i++)
+ {
+ printf ("zzrand %4d %9.3f\n", i, a[i]);
+ }
+ }
+ printf ("probable bug (randis)\n");
+ printmat (a, 1, n);
+ return n - 1;
}
-void ransamp(int *samp, int nsamp, double *p, int plen)
+void
+ransamp (int *samp, int nsamp, double *p, int plen)
/**
pick nsamp elements from random distribution
uses randis but array is at least sorted optimally
-*/
+ */
{
- double *px ;
- int *indx ;
- double y ;
- int i, j, k ;
-
- if (plen<=1) {
- ivzero(samp, nsamp) ;
- return ;
+ double *px;
+ int *indx;
+ double y;
+ int i, j, k;
+
+ if (plen <= 1)
+ {
+ ivzero (samp, nsamp);
+ return;
}
- ZALLOC(px, plen, double) ;
- ZALLOC(indx, plen, int) ;
-
- y = asum(p, plen) ;
- vst(px, p, -1.0/y, plen) ;
- sortit(px, indx, plen) ;
- vst(px, px, -1.0, plen) ;
-
- for (i=0; i<nsamp; i++) {
-/**
- really need binary chop picker
-*/
- j = randis(px, plen) ;
- if (j<0) {
- for (k=0; k<plen; k++) {
- printf("zz %d %d %12.6f %12.6f\n",k, indx[k], p[k], px[k]) ;
- }
- fatalx("bad ransamp\n") ;
- }
- k = indx[j] ;
- samp[i] = k ;
+ ZALLOC(px, plen, double);
+ ZALLOC(indx, plen, int);
+
+ y = asum (p, plen);
+ vst (px, p, -1.0 / y, plen);
+ sortit (px, indx, plen);
+ vst (px, px, -1.0, plen);
+
+ for (i = 0; i < nsamp; i++)
+ {
+ /**
+ really need binary chop picker
+ */
+ j = randis (px, plen);
+ if (j < 0)
+ {
+ for (k = 0; k < plen; k++)
+ {
+ printf ("zz %d %d %12.6f %12.6f\n", k, indx[k], p[k], px[k]);
+ }
+ fatalx ("bad ransamp\n");
+ }
+ k = indx[j];
+ samp[i] = k;
}
-
-
- free (px) ;
- free (indx) ;
+ free (px);
+ free (indx);
}
-void pick2(int n, int *k1, int *k2)
+void
+pick2 (int n, int *k1, int *k2)
{
- long l1 , l2 ;
- /* pick 2 distinct integers < n */ ;
- if (n<2) fatalx("bad pick2 call\n") ;
- for (;;) {
- l1 = LRAND() ;
- l2 = LRAND() ;
- l1 = l1%n ;
- l2 = l2%n ;
- if (l1 != l2) break ;
- }
- *k1 = l1 ;
- *k2 = l2 ;
+ long l1, l2;
+ /* pick 2 distinct integers < n */;
+ if (n < 2)
+ fatalx ("bad pick2 call\n");
+ for (;;)
+ {
+ l1 = LRAND ();
+ l2 = LRAND ();
+ l1 = l1 % n;
+ l2 = l2 % n;
+ if (l1 != l2)
+ break;
+ }
+ *k1 = l1;
+ *k2 = l2;
}
-void ranperm (int *a, int n)
+void
+ranperm (int *a, int n)
/**
a must be initialized say by idperm
-*/
+ */
{
- int l,k,tmp ;
- long r ;
- for (l=n; l>1 ; l--) {
-
- r = LRAND() ;
- k = r % l ;
-/* now swap k and l-1 */
- tmp = a[l-1] ; a[l-1]=a[k] ; a[k] = tmp ;
+ int l, k, tmp;
+ long r;
+ for (l = n; l > 1; l--)
+ {
+
+ r = LRAND ();
+ k = r % l;
+ /* now swap k and l-1 */
+ tmp = a[l - 1];
+ a[l - 1] = a[k];
+ a[k] = tmp;
- }
+ }
}
-int ranmod(int n)
+int
+ranmod (int n)
/* random number 0,...n-1 */
{
- long r, big ;
+ long r, big;
- if (n==0) fatalx("ranmod(0) called\n") ;
- if (n==1) return 0 ;
- big = (2 << 29) - 1 ;
- r = LRAND() ;
- r %= big ;
- return (r % n) ;
+ if (n == 0)
+ fatalx ("ranmod(0) called\n");
+ if (n == 1)
+ return 0;
+ big = (2 << 29) - 1;
+ r = LRAND ();
+ r %= big;
+ return (r % n);
}
-double ranbeta(double a, double b)
+double
+ranbeta (double a, double b)
{
- double xa, xb ;
+ double xa, xb;
- if ((a<=0.0) || (b<=0.0)) fatalx("(ranbeta) bad parameters: %9.3f %9.3f\n", a, b) ;
- xa = rangam(a) ;
- xb = rangam(b) ;
- return xa/(xa+xb) ;
+ if ((a <= 0.0) || (b <= 0.0))
+ fatalx ("(ranbeta) bad parameters: %9.3f %9.3f\n", a, b);
+ xa = rangam (a);
+ xb = rangam (b);
+ return xa / (xa + xb);
}
-int ranbinom(int n, double p)
+int
+ranbinom (int n, double p)
{
-/**
- Knuth Vol 2, p 131
-*/
+ /**
+ Knuth Vol 2, p 131
+ */
#define BTHRESH 50
- int a, b ;
- double x ;
- if (p>=1) return n ;
- if (p<=0) return 0 ;
- if (n<=0) return 0 ;
-
- if (n<=BTHRESH) {
- return ranb1(n,p) ; /** small case */
- }
-
- a = 1 + n/2 ;
- b = n + 1 - a ;
- x = ranbeta((double) a, (double) b) ;
- if (x>=p) return ranbinom(a-1, p/x) ;
- return (a + ranbinom(b-1, (p-x)/(1.0-x)) ) ;
+ int a, b;
+ double x;
+ if (p >= 1)
+ return n;
+ if (p <= 0)
+ return 0;
+ if (n <= 0)
+ return 0;
+
+ if (n <= BTHRESH)
+ {
+ return ranb1 (n, p); /** small case */
+ }
+
+ a = 1 + n / 2;
+ b = n + 1 - a;
+ x = ranbeta ((double) a, (double) b);
+ if (x >= p)
+ return ranbinom (a - 1, p / x);
+ return (a + ranbinom (b - 1, (p - x) / (1.0 - x)));
}
-static int ranb1 (int n, double p)
+static int
+ranb1 (int n, double p)
/**
binomial dis.
Naive routine
-*/
-{
- int cnt = 0, i ;
+ */
+{
+ int cnt = 0, i;
- for (i=0 ; i< n ; i++) {
- if (DRAND2() <= p) ++ cnt ;
+ for (i = 0; i < n; i++)
+ {
+ if (DRAND2() <= p)
+ ++cnt;
}
- return cnt ;
+ return cnt;
}
-int ewens(int *a, int n, double theta)
+int
+ewens (int *a, int n, double theta)
/**
implements the Ewens sampler. Categories 1...K
-*/
+ */
{
- int i, k, maxcat=0 ;
- double t, x ;
-
- if (n==0) return ;
- a[0] = maxcat = 1 ;
- for (i=1 ; i< n ; i++) {
- t = theta/ ((double) i + theta) ;
- x = DRAND2() ;
- if (x > t) {
- k = ranmod(i) ;
- a[i] = a[k] ;
- }
- else {
- ++maxcat ;
- a[i] = maxcat ;
- }
+ int i, k, maxcat = 0;
+ double t, x;
+
+ if (n == 0)
+ return;
+ a[0] = maxcat = 1;
+ for (i = 1; i < n; i++)
+ {
+ t = theta / ((double) i + theta);
+ x = DRAND2();
+ if (x > t)
+ {
+ k = ranmod (i);
+ a[i] = a[k];
+ }
+ else
+ {
+ ++maxcat;
+ a[i] = maxcat;
+ }
}
- return maxcat ;
+ return maxcat;
}
-double ranpoiss1(double xm)
+double
+ranpoiss1 (double xm)
/* poisson variable conditioned on x>0 */
/** xm should be small here
ranpoissx is the driver.
Don't call this directly
-*/
+ */
{
- double x, t, tc, s, y ;
- int k ;
- t = exp(-xm) ;
- tc = 1.0-t ;
- if (tc==0.0) return 1 ;
- y = t ;
- s = tc*DRAND2() ;
-/* s uniform [0, tc] */
- k = 1 ;
- y *= xm / (double) k ;
- for (;;) {
- if (s<y) return (double) k ;
- s -= y ;
- ++k ;
- y *= xm / (double) k ;
- if (k>=100) {
- fprintf(stderr,"(ranpoiss1) bug? xm: %12.6f\n", xm) ;
- return k ;
- }
+ double x, t, tc, s, y;
+ int k;
+ t = exp (-xm);
+ tc = 1.0 - t;
+ if (tc == 0.0)
+ return 1;
+ y = t;
+ s = tc * DRAND2();
+ /* s uniform [0, tc] */
+ k = 1;
+ y *= xm / (double) k;
+ for (;;)
+ {
+ if (s < y)
+ return (double) k;
+ s -= y;
+ ++k;
+ y *= xm / (double) k;
+ if (k >= 100)
+ {
+ fprintf (stderr, "(ranpoiss1) bug? xm: %12.6f\n", xm);
+ return k;
+ }
}
}
void
-genmultgauss(double *rvec, int num, int n, double *covar)
+genmultgauss (double *rvec, int num, int n, double *covar)
// rvec contains num mvg variates
{
- double *cf ;
- ZALLOC(cf, n*n, double) ;
- cholesky(cf, covar, n) ;
- transpose(cf, cf, n, n) ;
- gaussa(rvec, num*n) ;
- mulmat(rvec, rvec, cf, num, n, n) ;
- free(cf) ;
+ double *cf;
+ ZALLOC(cf, n*n, double);
+ cholesky (cf, covar, n);
+ transpose (cf, cf, n, n);
+ gaussa (rvec, num * n);
+ mulmat (rvec, rvec, cf, num, n, n);
+ free (cf);
}
-double drand2()
+double
+drand2 ()
{
- double x, y ;
- double maxran, maxran1 ;
- static double eps = -1.0 ;
-/**
- DRAND is quantized 1/2^31
- call it twice and get max precision
-*/
-
- if (eps < 0.0) {
- maxran = 1.0-DBL_EPSILON ;
- maxran1 = (double) (BIGINT-1) / (double) BIGINT ;
- eps = maxran - maxran1 ;
- }
-
- x = DRAND() ;
- y = DRAND() ;
- return x + y * eps ;
-}
+ double x, y;
+ double maxran, maxran1;
+ static double eps = -1.0;
+ /**
+ DRAND is quantized 1/2^31
+ call it twice and get max precision
+ */
+
+ if (eps < 0.0)
+ {
+ maxran = 1.0 - DBL_EPSILON;
+ maxran1 = (double) (BIGINT - 1) / (double) BIGINT;
+ eps = maxran - maxran1;
+ }
+ x = DRAND();
+ y = DRAND();
+ return x + y * eps;
+}
-void ranmultinom(int *samp, int n, double *p, int len)
+void
+ranmultinom (int *samp, int n, double *p, int len)
// multinomial sample p is prob dist n samples returned
// work is O(len^2) which is silly
{
- int x ;
- double *pp ;
-
- if (len==0) return ;
- ivzero(samp, len) ;
- if (n<=0) return ;
-
- if (len==1) {
- samp[0] = n ;
- return ;
- }
+ int x;
+ double *pp;
+
+ if (len == 0)
+ return;
+ ivzero (samp, len);
+ if (n <= 0)
+ return;
+
+ if (len == 1)
+ {
+ samp[0] = n;
+ return;
+ }
- ZALLOC(pp, len, double) ;
- copyarr(p, pp, len) ;
- bal1(pp, len) ;
+ ZALLOC(pp, len, double);
+ copyarr (p, pp, len);
+ bal1 (pp, len);
- samp[0] = x = ranbinom(n, pp[0]) ;
- ranmultinom(samp+1, n-x, p+1, len-1) ;
- free(pp) ;
+ samp[0] = x = ranbinom (n, pp[0]);
+ ranmultinom (samp + 1, n - x, p + 1, len - 1);
+ free (pp);
}
-double ranchi (int d)
+double
+ranchi (int d)
{
- double y ;
+ double y;
- y = 2.0 * rangam(0.5 * (double) d) ;
- return y ;
+ y = 2.0 * rangam (0.5 * (double) d);
+ return y;
}
-double raninvwis(double *wis, int t, int d, double *s)
+double
+raninvwis (double *wis, int t, int d, double *s)
// inverse Wishart: t d.o.f. d dimension S data matrix
// Ref Liu: Monte Carlo Strategies pp 40-41
{
- double *b, *n, *v, *cf, *ww, y ;
- int i, j ;
-
- if (t < d) {
- fatalx("(raninvwis) d.o.f. too small %d %d\n", t, d) ;
- }
-
- ZALLOC(b, d*d, double) ;
- ZALLOC(n, d*d, double) ;
- ZALLOC(v, d, double) ;
- ZALLOC(cf, d*d, double) ;
- ZALLOC(ww, d*d, double) ;
-
- for (i=0; i<d; i++) {
- v[i] = ranchi(t-i) ;
- for (j=0; j<i; j++) {
- n[i*d+j] = n[j*d+i] = gauss() ;
+ double *b, *n, *v, *cf, *ww, y;
+ int i, j;
+
+ if (t < d)
+ {
+ fatalx ("(raninvwis) d.o.f. too small %d %d\n", t, d);
+ }
+
+ ZALLOC(b, d*d, double);
+ ZALLOC(n, d*d, double);
+ ZALLOC(v, d, double);
+ ZALLOC(cf, d*d, double);
+ ZALLOC(ww, d*d, double);
+
+ for (i = 0; i < d; i++)
+ {
+ v[i] = ranchi (t - i);
+ for (j = 0; j < i; j++)
+ {
+ n[i * d + j] = n[j * d + i] = gauss ();
+ }
+ }
+
+ y = b[0] = v[0];
+ for (j = 1; j < d; j++)
+ {
+ b[j * d + 0] = b[j] = sqrt (y) * n[j];
}
- }
-
- y = b[0] = v[0] ;
- for (j=1; j<d; j++) {
- b[j*d+0] = b[j] = sqrt(y)*n[j] ;
- }
- for (j=1; j<d; j++) {
- b[j*d+j] = v[j] ;
- for (i=0; i<j; i++) {
- y = n[i*d+j] ;
- b[j*d+j] += y*y ;
- b[j*d+i] = b[i*d+j] = y*sqrt(v[i]) + vdot(n+i*d, n+j*d, i-1) ;
+ for (j = 1; j < d; j++)
+ {
+ b[j * d + j] = v[j];
+ for (i = 0; i < j; i++)
+ {
+ y = n[i * d + j];
+ b[j * d + j] += y * y;
+ b[j * d + i] = b[i * d + j] = y * sqrt (v[i])
+ + vdot (n + i * d, n + j * d, i - 1);
+ }
}
- }
-
- cholesky(cf, s, d) ;
- mulmat(ww, cf, b, d, d, d) ;
- transpose(cf, cf, d, d) ;
- mulmat(wis, ww, cf, d, d, d) ;
-
- free(b) ;
- free(n) ;
- free(v) ;
- free(cf) ;
- free(ww) ;
+
+ cholesky (cf, s, d);
+ mulmat (ww, cf, b, d, d, d);
+ transpose (cf, cf, d, d);
+ mulmat (wis, ww, cf, d, d, d);
+
+ free (b);
+ free (n);
+ free (v);
+ free (cf);
+ free (ww);
}
-double uniform(double lo, double hi)
+double
+uniform (double lo, double hi)
{
- double x, width ;
-
- width = hi - lo ;
+ double x, width;
- if (width < 0)
- return uniform(hi, lo) ;
-
- x = DRAND2() * width ;
+ width = hi - lo;
- return x + lo ;
+ if (width < 0)
+ return uniform (hi, lo);
-}
+ x = DRAND2() * width;
+ return x + lo;
-void randirichlet(double *x, double *pp, int n)
+}
+
+void
+randirichlet (double *x, double *pp, int n)
/**
generate dirichlet r.v. parameters pp
-*/
+ */
{
- int i ;
-
- vzero(x, n) ;
- for (i=0; i<n; i++) {
- if (pp[i] > 0.0) {
- x[i] = rangam(pp[i]) ;
- }
- }
- bal1(x,n) ;
+ int i;
+
+ vzero (x, n);
+ for (i = 0; i < n; i++)
+ {
+ if (pp[i] > 0.0)
+ {
+ x[i] = rangam (pp[i]);
+ }
+ }
+ bal1 (x, n);
}
-
-void randirmult(double *pp, int *aa, int len, int m)
+void
+randirmult (double *pp, int *aa, int len, int m)
{
-/**
- compound dirichlet - Multinomial
-*/
- int k ;
- double a, b, p ;
- double *x ;
-
- if (len==0) return ;
- if (len==1) {
- aa[0] = m ;
- return ;
+ /**
+ compound dirichlet - Multinomial
+ */
+ int k;
+ double a, b, p;
+ double *x;
+
+ if (len == 0)
+ return;
+ if (len == 1)
+ {
+ aa[0] = m;
+ return;
}
- ZALLOC(x, len, double) ;
- randirichlet(x, pp, len) ;
- ranmultinom(aa, m, x, len) ;
- free(x) ;
+ ZALLOC(x, len, double);
+ randirichlet (x, pp, len);
+ ranmultinom (aa, m, x, len);
+ free (x);
}
-int prob1(double p)
+int
+prob1 (double p)
// return YES with probability p
{
- double z ;
+ double z;
- if ((p<0) || (p>1)) fatalx("bad p %12.6f\n", p) ;
- z = DRAND2() ;
- if (z<p) return YES ;
+ if ((p < 0) || (p > 1))
+ fatalx ("bad p %12.6f\n", p);
+ z = DRAND2();
+ if (z < p)
+ return YES;
- return NO ;
+ return NO;
}
-double rant(double df)
+double
+rant (double df)
// t distribution df > 0
{
- static double p = -1, olddf = -1.0 ;
- static double zkon ;
- double y ;
-
- if (df <=- 0.0) fatalx("(rant) %9.3f\n") ;
-
- p = df/2.0 ;
- zkon = sqrt(p) ; // variance of t is p/(p-1) if p > 1
- y = rangam(p) ;
- if (y==0.0) y = p ; // special case to avoid overflow ;
- return gauss() * zkon / sqrt(y) ;
-}
-
-double samppow(double e, double a, double b)
+ static double p = -1, olddf = -1.0;
+ static double zkon;
+ double y;
+
+ if (df <= -0.0)
+ fatalx ("(rant) %9.3f\n");
+
+ p = df / 2.0;
+ zkon = sqrt (p); // variance of t is p/(p-1) if p > 1
+ y = rangam (p);
+ if (y == 0.0)
+ y = p; // special case to avoid overflow ;
+ return gauss () * zkon / sqrt (y);
+}
+
+double
+samppow (double e, double a, double b)
// sample x^e in range (a,b)
// uses cdf method since integral is analytic
// care taken to prevent underflow
{
- double ztot, rhs, zlog, ee, x ;
- double y1, y2, u ;
-
- ee = e+1.0 ;
- if (ee<0.0) fatalx("e must be > -1 \n") ; // fixable if integral finite
-
- if (b<a) return samppow(e, b, a) ;
- if (a==b) return a ;
-
- u = DRAND2() ; if (u==0.0) u = 0.5 ; // tiny hack
-
- y1 = ee*log(b) + log(u) ;
- if (a==0.0) zlog = y1 ;
- else {
- y2 = ee*log(a) + log(1.0-u) ;
- zlog = addlog(y1, y2) ;
- }
-
+ double ztot, rhs, zlog, ee, x;
+ double y1, y2, u;
+
+ ee = e + 1.0;
+ if (ee < 0.0)
+ fatalx ("e must be > -1 \n"); // fixable if integral finite
+
+ if (b < a)
+ return samppow (e, b, a);
+ if (a == b)
+ return a;
+
+ u = DRAND2();
+ if (u == 0.0)
+ u = 0.5; // tiny hack
+
+ y1 = ee * log (b) + log (u);
+ if (a == 0.0)
+ zlog = y1;
+ else
+ {
+ y2 = ee * log (a) + log (1.0 - u);
+ zlog = addlog (y1, y2);
+ }
-/**
- ztot = pow(b, ee) - pow(a, ee) ;
- rhs = ztot*DRAND() + pow(a, ee) ;
- zlog = log(rhs) ;
-*/
- x = exp(zlog/ee) ;
- return x ;
+ /**
+ ztot = pow(b, ee) - pow(a, ee) ;
+ rhs = ztot*DRAND() + pow(a, ee) ;
+ zlog = log(rhs) ;
+ */
+ x = exp (zlog / ee);
+ return x;
}
-double rantruncnorm(double T, int upper)
+double
+rantruncnorm (double T, int upper)
// random normal | > T (upper = 1)
{
- double u ;
+ double u;
- if (upper==0) return -rantruncnorm(-T, 1) ;
+ if (upper == 0)
+ return -rantruncnorm (-T, 1);
- u = DRAND2() ; if (u==0.0) u = 0.5 ; // tiny hack
- u *= ntail(T) ;
+ u = DRAND2();
+ if (u == 0.0)
+ u = 0.5; // tiny hack
+ u *= ntail (T);
- if (u==0.0) return MAX(T, 50.0) ;
- return zprob(u) ;
+ if (u == 0.0)
+ return MAX(T, 50.0);
+ return zprob (u);
}
-int ranhprob(int n, int a, int m)
+int
+ranhprob (int n, int a, int m)
// hypergeometric sampling
// rejection sampling. Devroye. Computing (1987) General method for log-concave densities
// where mode is known
/**
urn with n balls . a black balls. Pick m without replacement. Return number of black balls picked.
-*/
+ */
{
- double y ;
- double pm, logpm, w, ru, rw, rat ;
- int mode, k, x, zans ;
-
- mode = modehprob(n, a, m) ;
- logpm = loghprob(n, a, m, mode) ;
- pm = exp(logpm) ;
- w = 1 + pm ;
- for (;;) {
- ru = DRAND() ;
- rw = DRAND() ;
- if (ru <= w/(1+w)) y = DRAND()*w/pm ;
- else y = (w+ranexp())/pm ;
- x = nnint(y) ;
- if (ranmod(2)==0) x = -x ;
- zans = mode+x ;
- if (zans<0) continue ;
- if (zans>a) continue ;
- rat = exp(loghprob(n, a, m, zans)-logpm) ;
- rw *= MIN(1, exp(w-pm*y)) ;
- if (rw <= rat) break ;
- }
- return zans ;
-
+ double y;
+ double pm, logpm, w, ru, rw, rat;
+ int mode, k, x, zans;
+
+ mode = modehprob (n, a, m);
+ logpm = loghprob (n, a, m, mode);
+ pm = exp (logpm);
+ w = 1 + pm;
+ for (;;)
+ {
+ ru = DRAND();
+ rw = DRAND();
+ if (ru <= w / (1 + w))
+ y = DRAND() * w / pm;
+ else
+ y = (w + ranexp ()) / pm;
+ x = nnint (y);
+ if (ranmod (2) == 0)
+ x = -x;
+ zans = mode + x;
+ if (zans < 0)
+ continue;
+ if (zans > a)
+ continue;
+ rat = exp (loghprob (n, a, m, zans) - logpm);
+ rw *= MIN(1, exp (w - pm * y));
+ if (rw <= rat)
+ break;
+ }
+ return zans;
+
}
diff --git a/src/nicksrc/getpars.c b/src/nicksrc/getpars.c
index da01cf5..d2a025c 100644
--- a/src/nicksrc/getpars.c
+++ b/src/nicksrc/getpars.c
@@ -14,389 +14,454 @@
comments with line starting #
syntax: keyword param(s)
not designed to read large databases (needs hash code for that)
-*/
-void subcolon(char *ss) ;
-void stripcomment(char *str) ;
-int findpname(phandle *pp, char *parname) ;
-int indxstring(char **ppars, int npars, char *ww) ;
-
-static int parchange = 0 ;
-static int debug = NO ;
-
-phandle *openpars(char *fname)
+ */
+void
+subcolon (char *ss);
+void
+stripcomment (char *str);
+int
+findpname (phandle *pp, char *parname);
+int
+indxstring (char **ppars, int npars, char *ww);
+
+static int parchange = 0;
+static int debug = NO;
+
+phandle *
+openpars (char *fname)
/* constructor */
{
- phandle *pp ;
- FILE *ff ;
-
- char line[MAXSTR+1] ;
- char str[MAXSTR] ;
- char ww[MAXSTR] ;
- char rest[MAXSTR] ;
-
- char * ppars[MAXPARS] ;
- char * pdata[MAXPARS] ;
-
- int npars = 0, i ;
- int len, plen, t ;
-
- pp = (phandle *) malloc(sizeof(phandle)) ;
- ff = pp->fx = fopen(fname,"r") ;
- if (ff==NULL) {
- perror("Can't open file\n") ;
- fatalx("can't open %s\n",fname) ;
- }
-
- line[MAXSTR] = '\0' ; // defensive programmming
- while (fgets(line,MAXSTR,ff) != NULL) {
-
- len = strlen(line) ;
-
- if (isspace(line[len-1]))
- line[len-1] = '\0' ;
-
- if (first_word(line,ww,rest)>0) {
-
- if (ww[0] == '#') continue ;
- /*AT: 12/2/04: Adding check to make sure that the parameter name ends in : */
- plen = strlen(ww);
- if(ww[plen-1] != ':')
- printf("**warning: dubious parameter, please check the parameter name %s\n",ww);
- t = indxstring(ppars, npars, ww) ;
- if (t>=0) fatalx("duplicate parameter: %s\n", ww) ;
- ppars[npars] = strdup(ww) ;
-
- striptrail(rest, ' ') ; /* no trailing blanks */
- stripcomment(rest) ;
- pdata[npars] = strdup(rest) ;
- ++npars ;
-
- if (debug)
- printf("param %d %s %s\n",npars,ppars[npars-1],pdata[npars-1]) ;
-
- }
- }
- pp->numpars = npars ;
-
- if (npars>0) {
- ZALLOC(pp->ppars, npars, char *) ;
- ZALLOC(pp->pdata, npars, char *) ;
- }
- else {
- fprintf(stderr, "***warning: no parameters in %s\n", fname) ;
- }
-
-
- for (i=0; i<npars; i++) {
- pp->ppars[i] = strdup(ppars[i]) ;
- pp->pdata[i] = strdup(pdata[i]) ;
-
-
- /* printf("zz: %d %s %s\n",i,ppars[i],pp->ppars[i]) ;*/
-
- }
-
- for (i=0; i<npars; i++) {
- free(ppars[i]) ;
- free(pdata[i]) ;
- }
-
- return pp ;
+ phandle *pp;
+ FILE *ff;
+
+ char line[MAXSTR + 1];
+ char str[MAXSTR];
+ char ww[MAXSTR];
+ char rest[MAXSTR];
+
+ char * ppars[MAXPARS];
+ char * pdata[MAXPARS];
+
+ int npars = 0, i;
+ int len, plen, t;
+
+ pp = (phandle *) malloc (sizeof(phandle));
+ ff = pp->fx = fopen (fname, "r");
+ if (ff == NULL)
+ {
+ perror ("Can't open file\n");
+ fatalx ("can't open %s\n", fname);
+ }
+
+ line[MAXSTR] = '\0'; // defensive programmming
+ while (fgets (line, MAXSTR, ff) != NULL)
+ {
+
+ len = strlen (line);
+
+ if (isspace(line[len - 1]))
+ line[len - 1] = '\0';
+
+ if (first_word (line, ww, rest) > 0)
+ {
+
+ if (ww[0] == '#')
+ continue;
+ /*AT: 12/2/04: Adding check to make sure that the parameter name ends in : */
+ plen = strlen (ww);
+ if (ww[plen - 1] != ':')
+ printf (
+ "**warning: dubious parameter, please check the parameter name %s\n",
+ ww);
+ t = indxstring (ppars, npars, ww);
+ if (t >= 0)
+ fatalx ("duplicate parameter: %s\n", ww);
+ ppars[npars] = strdup (ww);
+
+ striptrail (rest, ' '); /* no trailing blanks */
+ stripcomment (rest);
+ pdata[npars] = strdup (rest);
+ ++npars;
+
+ if (debug)
+ printf ("param %d %s %s\n", npars, ppars[npars - 1],
+ pdata[npars - 1]);
+
+ }
+ }
+ pp->numpars = npars;
+
+ if (npars > 0)
+ {
+ ZALLOC(pp->ppars, npars, char *);
+ ZALLOC(pp->pdata, npars, char *);
+ }
+ else
+ {
+ fprintf (stderr, "***warning: no parameters in %s\n", fname);
+ }
+
+ for (i = 0; i < npars; i++)
+ {
+ pp->ppars[i] = strdup (ppars[i]);
+ pp->pdata[i] = strdup (pdata[i]);
+
+ /* printf("zz: %d %s %s\n",i,ppars[i],pp->ppars[i]) ;*/
+
+ }
+
+ for (i = 0; i < npars; i++)
+ {
+ free (ppars[i]);
+ free (pdata[i]);
+ }
+
+ return pp;
}
-void closepars(phandle *pp)
+void
+closepars (phandle *pp)
/* destructor */
{
- int n, i;
-
- fclose(pp->fx) ;
- n = pp->numpars ;
- for (i=0; i<n; i++) {
- free(pp->ppars[i]) ;
- free(pp->pdata[i]) ;
- }
-
- free(pp->ppars) ;
- free(pp->pdata) ;
+ int n, i;
+
+ fclose (pp->fx);
+ n = pp->numpars;
+ for (i = 0; i < n; i++)
+ {
+ free (pp->ppars[i]);
+ free (pp->pdata[i]);
+ }
- free(pp) ;
- pp = NULL ;
+ free (pp->ppars);
+ free (pp->pdata);
+ free (pp);
+ pp = NULL;
}
-void stripcomment(char *str)
+void
+stripcomment (char *str)
{
- int i, len ;
-
- len = strlen(str) ;
-
- for (i=0; i<len; i++) {
- if (str[i] == '#') {
- str[i] = '\0' ;
- return ;
- }
- }
+ int i, len;
+
+ len = strlen (str);
+
+ for (i = 0; i < len; i++)
+ {
+ if (str[i] == '#')
+ {
+ str[i] = '\0';
+ return;
+ }
+ }
}
#define MAXFIELD 1000
-int getstring(phandle *pp, char *parname, char **strng)
+int
+getstring (phandle *pp, char *parname, char **strng)
{
- char *field[MAXFIELD] ;
- int n, kode ;
+ char *field[MAXFIELD];
+ int n, kode;
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- n = splitup(pp->pdata[kode],field,MAXFIELD) ;
- *strng = strdup(field[0]) ;
- freeup(field, n) ;
- return 1 ;
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ n = splitup (pp->pdata[kode], field, MAXFIELD);
+ *strng = strdup (field[0]);
+ freeup (field, n);
+ return 1;
}
-
-int getint(phandle *pp, char *parname, int *kret)
+int
+getint (phandle *pp, char *parname, int *kret)
{
- char *field[MAXFIELD] ;
- char str[MAXSTR] ;
- int n, kode ;
-
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- n = splitup(pp->pdata[kode],field,MAXFIELD) ;
- strcpy(str, field[0]) ;
- freeup(field, n) ;
- if (strcmp(str,"YES")==0) {
- *kret = YES ;
- return 1;
- }
- if (strcmp(str,"NO")==0) {
- *kret = NO ;
- return 1;
- }
-
- *kret = atoi(str) ;
- return 1 ;
+ char *field[MAXFIELD];
+ char str[MAXSTR];
+ int n, kode;
+
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ n = splitup (pp->pdata[kode], field, MAXFIELD);
+ strcpy (str, field[0]);
+ freeup (field, n);
+ if (strcmp (str, "YES") == 0)
+ {
+ *kret = YES;
+ return 1;
+ }
+ if (strcmp (str, "NO") == 0)
+ {
+ *kret = NO;
+ return 1;
+ }
+
+ *kret = atoi (str);
+ return 1;
}
-int getints(phandle *pp, char *parname, int *aint, int nint)
+int
+getints (phandle *pp, char *parname, int *aint, int nint)
{
- char *field[MAXFIELD] ;
- int n, kode, i ;
- char str[MAXSTR] ;
+ char *field[MAXFIELD];
+ int n, kode, i;
+ char str[MAXSTR];
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
- strcpy(str, pp->pdata[kode]) ;
- subcolon(str) ;
- n = splitup(str,field,MAXFIELD) ;
+ strcpy (str, pp->pdata[kode]);
+ subcolon (str);
+ n = splitup (str, field, MAXFIELD);
- if (nint < n) fatalx("(getints) wrong number of ints in line\n") ;
+ if (nint < n)
+ fatalx ("(getints) wrong number of ints in line\n");
- for (i=0; i<n; i++) {
- aint[i] = atoi(field[i]) ;
- }
- freeup(field, n) ;
- return n ;
+ for (i = 0; i < n; i++)
+ {
+ aint[i] = atoi (field[i]);
+ }
+ freeup (field, n);
+ return n;
}
-int getintss(phandle *pp, char *parname, int *aint, int *xint)
+int
+getintss (phandle *pp, char *parname, int *aint, int *xint)
/* white space separated */
{
- char *field[MAXFIELD] ;
- int n, kode, i ;
- char str[MAXSTR] ;
-
- *xint = 0 ;
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- strcpy(str, pp->pdata[kode]) ;
- subcolon(str) ;
- n = splitup(str,field,MAXFIELD) ;
- for (i=0; i<n; i++) {
- aint[i] = atoi(field[i]) ;
- }
- freeup(field, n) ;
- *xint = n ;
+ char *field[MAXFIELD];
+ int n, kode, i;
+ char str[MAXSTR];
+
+ *xint = 0;
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ strcpy (str, pp->pdata[kode]);
+ subcolon (str);
+ n = splitup (str, field, MAXFIELD);
+ for (i = 0; i < n; i++)
+ {
+ aint[i] = atoi (field[i]);
+ }
+ freeup (field, n);
+ *xint = n;
return 1;
}
-int getdbls(phandle *pp, char *parname, double *dbl, int ndbl)
+int
+getdbls (phandle *pp, char *parname, double *dbl, int ndbl)
{
- char *field[MAXFIELD] ;
- int n, kode, i ;
- char str[MAXSTR] ;
-
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- strcpy(str, pp->pdata[kode]) ;
- subcolon(str) ;
- n = splitup(str,field,MAXFIELD) ;
- if (ndbl != n) fatalx("(getdbls) wrong number of dbls in line\n") ;
- for (i=0; i<n; i++) {
- dbl[i] = atof(field[i]) ;
- }
- freeup(field, n) ;
- return 1 ;
+ char *field[MAXFIELD];
+ int n, kode, i;
+ char str[MAXSTR];
+
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ strcpy (str, pp->pdata[kode]);
+ subcolon (str);
+ n = splitup (str, field, MAXFIELD);
+ if (ndbl != n)
+ fatalx ("(getdbls) wrong number of dbls in line\n");
+ for (i = 0; i < n; i++)
+ {
+ dbl[i] = atof (field[i]);
+ }
+ freeup (field, n);
+ return 1;
}
-int getdblss(phandle *pp, char *parname, double *dbl, int *ndbl)
+int
+getdblss (phandle *pp, char *parname, double *dbl, int *ndbl)
/* separated no check */
{
- char *field[MAXFIELD] ;
- int n, kode, i ;
- char str[MAXSTR] ;
-
- *ndbl = 0 ;
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- strcpy(str, pp->pdata[kode]) ;
- subcolon(str) ;
- n = splitup(str,field,MAXFIELD) ;
- for (i=0; i<n; i++) {
- dbl[i] = atof(field[i]) ;
- }
- freeup(field, n) ;
- *ndbl = n ;
+ char *field[MAXFIELD];
+ int n, kode, i;
+ char str[MAXSTR];
+
+ *ndbl = 0;
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ strcpy (str, pp->pdata[kode]);
+ subcolon (str);
+ n = splitup (str, field, MAXFIELD);
+ for (i = 0; i < n; i++)
+ {
+ dbl[i] = atof (field[i]);
+ }
+ freeup (field, n);
+ *ndbl = n;
return 1;
}
-void subcolon(char *ss)
+void
+subcolon (char *ss)
/* substitute ' ' for ':' or ',' */
{
- int i, l ;
- l = strlen(ss) ;
- for (i=0; i<l ; i++) {
- if (ss[i] == ':') ss[i] = ' ' ;
- if (ss[i] == ',') ss[i] = ' ' ;
- }
+ int i, l;
+ l = strlen (ss);
+ for (i = 0; i < l; i++)
+ {
+ if (ss[i] == ':')
+ ss[i] = ' ';
+ if (ss[i] == ',')
+ ss[i] = ' ';
+ }
}
-
-int getdbl(phandle *pp, char *parname, double *dbl)
+int
+getdbl (phandle *pp, char *parname, double *dbl)
{
- char *field[MAXFIELD] ;
- int n, kode ;
-
- kode = findpname(pp, parname) ;
- if (kode<0) return kode ;
- n = splitup(pp->pdata[kode],field,MAXFIELD) ;
- *dbl = atof(field[0]) ;
- freeup(field, n) ;
- return 1 ;
+ char *field[MAXFIELD];
+ int n, kode;
+
+ kode = findpname (pp, parname);
+ if (kode < 0)
+ return kode;
+ n = splitup (pp->pdata[kode], field, MAXFIELD);
+ *dbl = atof (field[0]);
+ freeup (field, n);
+ return 1;
}
-int findpname(phandle *pp, char *parname)
+int
+findpname (phandle *pp, char *parname)
{
- int k ;
+ int k;
- for (k=0; k < pp->numpars; k++) {
- if (strcmp(parname, pp->ppars[k]) == 0 )
- return k ;
+ for (k = 0; k < pp->numpars; k++)
+ {
+ if (strcmp (parname, pp->ppars[k]) == 0)
+ return k;
}
- return -1 ;
+ return -1;
}
-void writepars(phandle *pp)
+void
+writepars (phandle *pp)
{
- int k ;
- if (pp==NULL) fatalx("(writepars) phandle not open\n") ;
- for (k=0; k < pp->numpars; k++) {
- printf("%s %s\n", pp->ppars[k], pp->pdata[k]) ;
- }
+ int k;
+ if (pp == NULL)
+ fatalx ("(writepars) phandle not open\n");
+ for (k = 0; k < pp->numpars; k++)
+ {
+ printf ("%s %s\n", pp->ppars[k], pp->pdata[k]);
+ }
}
-void fwritepars(FILE *fff, phandle *pp)
+void
+fwritepars (FILE *fff, phandle *pp)
{
- int k ;
- if (pp==NULL) fatalx("(writepars) phandle not open\n") ;
- for (k=0; k < pp->numpars; k++) {
- fprintf(fff, "%s %s\n", pp->ppars[k], pp->pdata[k]) ;
- }
+ int k;
+ if (pp == NULL)
+ fatalx ("(writepars) phandle not open\n");
+ for (k = 0; k < pp->numpars; k++)
+ {
+ fprintf (fff, "%s %s\n", pp->ppars[k], pp->pdata[k]);
+ }
}
-
-void dostrsub(phandle *pp)
-{
-/**
- massage phandle data structure
- to do string substitutions of
- UPPER case paramewters
-*/
-
- int n, nu, nl ;
- int *isupp, *islow, *slenm, *indx ;
- int i, j, k, l, ind ;
- int nchange = 0 ;
- char *inx, *outx ;
- n = pp->numpars ;
-
- ZALLOC(isupp, n, int) ;
- ZALLOC(islow, n, int) ;
- ZALLOC(slenm, n, int) ;
- ZALLOC(indx, n, int) ;
-
- nu = nl = 0 ;
- for (k=0; k < pp->numpars; k++) {
- if (upstring(pp->ppars[k])) {
- isupp[nu] = k ;
- l = strlen(pp->ppars[k]) ;
- slenm[nu] = -(10000*l-k) ;
-
-/**
- after sorting longest first then order in file
- ensures sort is stable
-*/
-
- ++nu ;
- }
- else {
- islow[nl] = k ;
- ++nl ;
- }
- }
- if (nu==0) return ;
- isortit(slenm, indx, nu) ;
- for (i=0; i< nu; i++) {
- ind = indx[i] ;
- k = isupp[ind] ;
- inx = strdup(pp->ppars[k]) ;
- l = strlen(inx) ;
- if (inx[l-1] == ':') inx[l-1] = '\0' ;
- outx = strdup(pp->pdata[k]) ;
- for (j=0; j< nl; j++) {
- k = islow[j] ;
- nchange += substring(&(pp -> pdata[k]), inx, outx) ;
- if (nchange>0) break ;
+void
+dostrsub (phandle *pp)
+{
+ /**
+ massage phandle data structure
+ to do string substitutions of
+ UPPER case paramewters
+ */
+
+ int n, nu, nl;
+ int *isupp, *islow, *slenm, *indx;
+ int i, j, k, l, ind;
+ int nchange = 0;
+ char *inx, *outx;
+ n = pp->numpars;
+
+ ZALLOC(isupp, n, int);
+ ZALLOC(islow, n, int);
+ ZALLOC(slenm, n, int);
+ ZALLOC(indx, n, int);
+
+ nu = nl = 0;
+ for (k = 0; k < pp->numpars; k++)
+ {
+ if (upstring (pp->ppars[k]))
+ {
+ isupp[nu] = k;
+ l = strlen (pp->ppars[k]);
+ slenm[nu] = -(10000 * l - k);
+
+ /**
+ after sorting longest first then order in file
+ ensures sort is stable
+ */
+
+ ++nu;
+ }
+ else
+ {
+ islow[nl] = k;
+ ++nl;
+ }
+ }
+ if (nu == 0)
+ return;
+ isortit (slenm, indx, nu);
+ for (i = 0; i < nu; i++)
+ {
+ ind = indx[i];
+ k = isupp[ind];
+ inx = strdup (pp->ppars[k]);
+ l = strlen (inx);
+ if (inx[l - 1] == ':')
+ inx[l - 1] = '\0';
+ outx = strdup (pp->pdata[k]);
+ for (j = 0; j < nl; j++)
+ {
+ k = islow[j];
+ nchange += substring (&(pp->pdata[k]), inx, outx);
+ if (nchange > 0)
+ break;
+ }
+ free (inx);
+ free (outx);
}
- free(inx) ;
- free(outx) ;
- }
- free(isupp) ;
- free(islow) ;
- free(slenm) ;
- free(indx) ;
-
- parchange += nchange ;
- if (parchange>10000) fatalx("(getpars) dostrsub looping\n") ;
- if (nchange>0) dostrsub(pp) ;
+ free (isupp);
+ free (islow);
+ free (slenm);
+ free (indx);
+
+ parchange += nchange;
+ if (parchange > 10000)
+ fatalx ("(getpars) dostrsub looping\n");
+ if (nchange > 0)
+ dostrsub (pp);
}
-int upstring (char *ss)
+int
+upstring (char *ss)
/*
YES if at least one upper case character
and no lower case
-*/
+ */
{
- int nupper = 0 ;
- int i ;
- for (i=0; i<strlen(ss); i++)
-
- {
- if (islower(ss[i])) return NO ;
- if (isupper(ss[i])) ++nupper ;
- }
- if (nupper>0) return YES ;
- return NO ;
+ int nupper = 0;
+ int i;
+ for (i = 0; i < strlen (ss); i++)
+
+ {
+ if (islower(ss[i]))
+ return NO;
+ if (isupper(ss[i]))
+ ++nupper;
+ }
+ if (nupper > 0)
+ return YES;
+ return NO;
}
diff --git a/src/nicksrc/linsubs.c b/src/nicksrc/linsubs.c
index 42fd89a..aee25ce 100644
--- a/src/nicksrc/linsubs.c
+++ b/src/nicksrc/linsubs.c
@@ -6,274 +6,287 @@
#include "vsubs.h"
#include "strsubs.h"
#include "linsubs.h"
-static int linsolvx(int nDim, double* pfMatr, double* pfVect, double* pfSolution) ;
-static int calcdet = NO ;
+static int
+linsolvx (int nDim, double* pfMatr, double* pfVect, double* pfSolution);
+static int calcdet = NO;
-int setcalcdet (int val)
+int
+setcalcdet (int val)
{
- calcdet = val ;
+ calcdet = val;
}
-void bal(double *a, double *b, int n)
+void
+bal (double *a, double *b, int n)
/**
normalize mean 0 s.d 1
-*/
+ */
{
- double t ;
- t = asum(b,n)/ (double) n ;
- vsp (a, b, -t, n) ;
+ double t;
+ t = asum (b, n) / (double) n;
+ vsp (a, b, -t, n);
- t = asum2(a,n)/ (double) n ;
- vst (a, a, 1.0/sqrt(t), n) ;
+ t = asum2 (a, n) / (double) n;
+ vst (a, a, 1.0 / sqrt (t), n);
}
-void mulmat(double *a, double *b, double *c, int a1, int a2, int a3)
-/* b is a1 x a2 , c a2 x a3 so a is a1 x a3 */
+void
+mulmat (double *a, double *b, double *c, int a1, int a2, int a3)
+/* b is a1 x a2 , c a2 x a3 so a is a1 x a3 */
{
- double *t ;
- int i,j,k ;
- ZALLOC(t, a1*a3, double) ;
+ double *t;
+ int i, j, k;
+ ZALLOC(t, a1*a3, double);
- for (i=0; i<a1; i++)
- for (j=0; j<a3; j++)
- for (k=0; k<a2; k++)
- t[i*a3+j] += b[i*a2+k]*c[k*a3+j] ;
+ for (i = 0; i < a1; i++)
+ for (j = 0; j < a3; j++)
+ for (k = 0; k < a2; k++)
+ t[i * a3 + j] += b[i * a2 + k] * c[k * a3 + j];
- copyarr(t, a, a1*a3) ;
+ copyarr (t, a, a1 * a3);
- free (t) ;
+ free (t);
}
-void imulmat(int *a, int *b, int *c, int a1, int a2, int a3)
-/* b is a1 x a2 , c a2 x a3 so a is a1 x a3 */
+void
+imulmat (int *a, int *b, int *c, int a1, int a2, int a3)
+/* b is a1 x a2 , c a2 x a3 so a is a1 x a3 */
{
- int *t ;
- int i,j,k ;
- ZALLOC(t, a1*a3, int) ;
+ int *t;
+ int i, j, k;
+ ZALLOC(t, a1*a3, int);
- for (i=0; i<a1; i++)
- for (j=0; j<a3; j++)
- for (k=0; k<a2; k++)
- t[i*a3+j] += b[i*a2+k]*c[k*a3+j] ;
+ for (i = 0; i < a1; i++)
+ for (j = 0; j < a3; j++)
+ for (k = 0; k < a2; k++)
+ t[i * a3 + j] += b[i * a2 + k] * c[k * a3 + j];
- copyiarr(t, a, a1*a3) ;
+ copyiarr (t, a, a1 * a3);
- free (t) ;
+ free (t);
}
-
-double pdinv(double *cinv, double *coeff, int n)
+double
+pdinv (double *cinv, double *coeff, int n)
// cinv and coeff can be same
// cinv can be NULL
// return log det (coeff)
{
- double *tt;
- double *p ;
- double t, sum, y ;
- int i,j, k ;
+ double *tt;
+ double *p;
+ double t, sum, y;
+ int i, j, k;
-/**
+ /**
pmat(coeff, n) ;
-*/
- ZALLOC (tt, n*n, double);
- ZALLOC (p, n, double );
-
-
- copyarr(coeff,tt,n*n);
-
- choldc (tt, n, p) ;
-
-
- for (i=0; i<n; i++) {
- tt[i*n+i] = 1.0/p[i] ;
- for (j=i+1; j<n; j++) {
- sum=0.0 ;
- for (k=i; k<j; k++) {
- sum -= tt[j*n+k]*tt[k*n+i] ;
- }
- tt[j*n+i] = sum/p[j] ;
+ */
+ ZALLOC(tt, n * n, double);
+ ZALLOC(p, n, double);
- }
- }
-
- for (i=0; i<n; i++)
- for (j=i; j<n; j++) {
- sum=0.0 ;
- if (cinv == NULL) break ;
- for (k=j; k<n; k++) {
- sum += tt[k*n+j]*tt[k*n+i] ;
- }
- cinv[i*n+j] = cinv[j*n+i] = sum ;
+ copyarr (coeff, tt, n * n);
+
+ choldc (tt, n, p);
+
+ for (i = 0; i < n; i++)
+ {
+ tt[i * n + i] = 1.0 / p[i];
+ for (j = i + 1; j < n; j++)
+ {
+ sum = 0.0;
+ for (k = i; k < j; k++)
+ {
+ sum -= tt[j * n + k] * tt[k * n + i];
+ }
+ tt[j * n + i] = sum / p[j];
+
+ }
}
- vlog(p, p, n) ;
- y = 2.0*asum(p, n) ;
+ for (i = 0; i < n; i++)
+ for (j = i; j < n; j++)
+ {
+ sum = 0.0;
+ if (cinv == NULL)
+ break;
+ for (k = j; k < n; k++)
+ {
+ sum += tt[k * n + j] * tt[k * n + i];
+ }
+ cinv[i * n + j] = cinv[j * n + i] = sum;
+ }
+ vlog (p, p, n);
+ y = 2.0 * asum (p, n);
- free(tt) ;
- free(p) ;
+ free (tt);
+ free (p);
- return y ;
+ return y;
}
-int
-solvit (double *prod, double *rhs, int n, double *ans)
-{
+int
+solvit (double *prod, double *rhs, int n, double *ans)
+{
//The coefficient matrix should be positive definite
/*AT : changed this code to take in matrix in a linear array form*/
- double *ttt;
- double *b;
- double *p;
- int i ;
- int ret ;
-
-
- ZALLOC (ttt, n*n, double);
- ZALLOC (p, n, double);
- ZALLOC(b,n,double);
-
- copyarr(prod,ttt,n*n);
- copyarr(rhs,b,n);
-
- ret = choldc (ttt, n, p);
- if (ret<0) return -1 ; // not pos def
- cholsl (ttt, n, p, b, ans);
-
- free (ttt) ;
- free(b);
- free (p) ;
+ double *ttt;
+ double *b;
+ double *p;
+ int i;
+ int ret;
+
+ ZALLOC(ttt, n * n, double);
+ ZALLOC(p, n, double);
+ ZALLOC(b, n, double);
+
+ copyarr (prod, ttt, n * n);
+ copyarr (rhs, b, n);
+
+ ret = choldc (ttt, n, p);
+ if (ret < 0)
+ return -1; // not pos def
+ cholsl (ttt, n, p, b, ans);
+
+ free (ttt);
+ free (b);
+ free (p);
// printf("zzsol: %d %g %g %g\n", n, prod[0], rhs[0], ans[0]) ;
-
- return 1 ;
-}
-void
+ return 1;
+}
+
+void
cholsl (double *a, int n, double p[], double b[], double x[])
/**
Numerical Recipes. Must change
-*/
+ */
{
/*AT: Changing the code*/
- int i, k;
- double sum;
-
-
- for (i = 0; i < n; i++)
- {
- sum = b[i];
- for (k = i - 1; k >= 0; k--)
- sum -= a[i*n+k] * x[k];
- x[i] = sum / p[i];
- }
-
- for (i = (n-1); i >= 0; i--)
- {
- sum = x[i];
- for (k = i + 1; k < n; k++)
- sum -= a[k*n+i]* x[k];
- x[i] = sum / p[i];
- }
+ int i, k;
+ double sum;
+
+ for (i = 0; i < n; i++)
+ {
+ sum = b[i];
+ for (k = i - 1; k >= 0; k--)
+ sum -= a[i * n + k] * x[k];
+ x[i] = sum / p[i];
+ }
+ for (i = (n - 1); i >= 0; i--)
+ {
+ sum = x[i];
+ for (k = i + 1; k < n; k++)
+ sum -= a[k * n + i] * x[k];
+ x[i] = sum / p[i];
+ }
}
-int
+int
choldc (double *a, int n, double p[])
{
- int i, j,k;
- double sum;
-
-
- for (i = 0; i < n; i++)
- {
- for (j = i; j < n; j++)
- {
- sum = a[i*n+j];
- for (k = i - 1; k >= 0; k--)
- sum -= a[i*n+k] * a[j*n+k];
- if (i == j)
- {
- /**
- printf("zzchol %d %20.10f %9.3f\n",i, sum, a[i][i]) ;
- */
- if (sum <= 0.0) {
- return -1 ; // not pos def
- }
- p[i] = sqrt (sum);
- }
- else
- {
- a[j*n+i] = sum / p[i];
-
- }
- }
- }
-
- return 1 ;
-
+ int i, j, k;
+ double sum;
+
+ for (i = 0; i < n; i++)
+ {
+ for (j = i; j < n; j++)
+ {
+ sum = a[i * n + j];
+ for (k = i - 1; k >= 0; k--)
+ sum -= a[i * n + k] * a[j * n + k];
+ if (i == j)
+ {
+ /**
+ printf("zzchol %d %20.10f %9.3f\n",i, sum, a[i][i]) ;
+ */
+ if (sum <= 0.0)
+ {
+ return -1; // not pos def
+ }
+ p[i] = sqrt (sum);
+ }
+ else
+ {
+ a[j * n + i] = sum / p[i];
+
+ }
+ }
+ }
+
+ return 1;
+
}
-void pmat(double *mat, int n)
+void
+pmat (double *mat, int n)
/**
print square matrix
-*/
+ */
{
- int i,j ;
- double *diag ;
-
- ZALLOC(diag,n, double) ;
- getdiag(diag, mat, n) ;
-
- printf("pmat:\n") ;
-
- for (i=0; i<n; i++) {
- printf("diag %5d %9.3f\n",i, diag[i]) ;
- for (j=0; j<n; j++) {
- if ((j%10) == 9) printf("\n") ;
- if ((n%10) != 0) printf("%9.3f ",mat[i*n+j]) ;
- }
- printf("\n") ;
- }
- printf("\n") ;
- printf("\n") ;
-
- free(diag) ;
+ int i, j;
+ double *diag;
+
+ ZALLOC(diag,n, double);
+ getdiag (diag, mat, n);
+
+ printf ("pmat:\n");
+
+ for (i = 0; i < n; i++)
+ {
+ printf ("diag %5d %9.3f\n", i, diag[i]);
+ for (j = 0; j < n; j++)
+ {
+ if ((j % 10) == 9)
+ printf ("\n");
+ if ((n % 10) != 0)
+ printf ("%9.3f ", mat[i * n + j]);
+ }
+ printf ("\n");
+ }
+ printf ("\n");
+ printf ("\n");
+
+ free (diag);
}
-void cholesky(double *cf, double *a, int n)
-{
- int i, j, k ;
- double *tt ;
- double *p ;
-
- ZALLOC(tt, n*n, double) ;
- ZALLOC(p, n, double) ;
- copyarr(a,tt,n*n);
+void
+cholesky (double *cf, double *a, int n)
+{
+ int i, j, k;
+ double *tt;
+ double *p;
+ ZALLOC(tt, n*n, double);
+ ZALLOC(p, n, double);
+ copyarr (a, tt, n * n);
- choldc(tt, n, p ) ;
+ choldc (tt, n, p);
- vzero(cf, n*n) ;
+ vzero (cf, n * n);
- for (i = 0; i < n; i++) {
- tt[i*n+i] = p[i] ;
-
- for (j=0; j <= i ; j++) {
- k = i*n+j ;
- cf[k] = tt[i*n+j] ;
+ for (i = 0; i < n; i++)
+ {
+ tt[i * n + i] = p[i];
+
+ for (j = 0; j <= i; j++)
+ {
+ k = i * n + j;
+ cf[k] = tt[i * n + j];
+ }
}
- }
-
- free(tt) ;
- free(p) ;
+
+ free (tt);
+ free (p);
}
//==============================================================================
//
@@ -283,90 +296,91 @@ void cholesky(double *cf, double *a, int n)
//
//==============================================================================
-int linsolv(int n, double *pfMatr, double *pfVect, double *sol)
+int
+linsolv (int n, double *pfMatr, double *pfVect, double *sol)
// 1 on failure
{
- int ret ;
- double *a, *rhs ;
+ int ret;
+ double *a, *rhs;
- ZALLOC(a, n*n, double) ;
- ZALLOC(rhs, n, double) ;
+ ZALLOC(a, n*n, double);
+ ZALLOC(rhs, n, double);
- copyarr(pfMatr, a, n*n) ;
- copyarr(pfVect, rhs, n) ;
+ copyarr (pfMatr, a, n * n);
+ copyarr (pfVect, rhs, n);
- ret = linsolvx(n, a, rhs, sol) ;
+ ret = linsolvx (n, a, rhs, sol);
- free(a) ;
- free(rhs) ;
-
-
- return ret ;
+ free (a);
+ free (rhs);
+ return ret;
}
-int linsolvx(int nDim, double *pfMatr, double *pfVect, double *pfSolution)
+int
+linsolvx (int nDim, double *pfMatr, double *pfVect, double *pfSolution)
{
double fMaxElem;
double fAcc;
- int i , j, k, m;
-
+ int i, j, k, m;
- for(k=0; k<(nDim-1); k++) // base row of matrix
- {
- // search of line with max element
- fMaxElem = fabs( pfMatr[k*nDim + k] );
- m = k;
- for(i=k+1; i<nDim; i++)
+ for (k = 0; k < (nDim - 1); k++) // base row of matrix
{
- if(fMaxElem < fabs(pfMatr[i*nDim + k]) )
- {
- fMaxElem = pfMatr[i*nDim + k];
- m = i;
- }
- }
-
- // permutation of base line (index k) and max element line(index m)
- if(m != k)
- {
- for(i=k; i<nDim; i++)
- {
- fAcc = pfMatr[k*nDim + i];
- pfMatr[k*nDim + i] = pfMatr[m*nDim + i];
- pfMatr[m*nDim + i] = fAcc;
- }
- fAcc = pfVect[k];
- pfVect[k] = pfVect[m];
- pfVect[m] = fAcc;
- }
-
- if( pfMatr[k*nDim + k] == 0.) return 1; // needs improvement !!!
-
- // triangulation of matrix with coefficients
- for(j=(k+1); j<nDim; j++) // current row of matrix
- {
- fAcc = - pfMatr[j*nDim + k] / pfMatr[k*nDim + k];
- for(i=k; i<nDim; i++)
- {
- pfMatr[j*nDim + i] = pfMatr[j*nDim + i] + fAcc*pfMatr[k*nDim + i];
- }
- pfVect[j] = pfVect[j] + fAcc*pfVect[k]; // free member recalculation
+ // search of line with max element
+ fMaxElem = fabs (pfMatr[k * nDim + k]);
+ m = k;
+ for (i = k + 1; i < nDim; i++)
+ {
+ if (fMaxElem < fabs (pfMatr[i * nDim + k]))
+ {
+ fMaxElem = pfMatr[i * nDim + k];
+ m = i;
+ }
+ }
+
+ // permutation of base line (index k) and max element line(index m)
+ if (m != k)
+ {
+ for (i = k; i < nDim; i++)
+ {
+ fAcc = pfMatr[k * nDim + i];
+ pfMatr[k * nDim + i] = pfMatr[m * nDim + i];
+ pfMatr[m * nDim + i] = fAcc;
+ }
+ fAcc = pfVect[k];
+ pfVect[k] = pfVect[m];
+ pfVect[m] = fAcc;
+ }
+
+ if (pfMatr[k * nDim + k] == 0.)
+ return 1; // needs improvement !!!
+
+ // triangulation of matrix with coefficients
+ for (j = (k + 1); j < nDim; j++) // current row of matrix
+ {
+ fAcc = -pfMatr[j * nDim + k] / pfMatr[k * nDim + k];
+ for (i = k; i < nDim; i++)
+ {
+ pfMatr[j * nDim + i] = pfMatr[j * nDim + i]
+ + fAcc * pfMatr[k * nDim + i];
+ }
+ pfVect[j] = pfVect[j] + fAcc * pfVect[k]; // free member recalculation
+ }
}
- }
- for(k=(nDim-1); k>=0; k--)
- {
- pfSolution[k] = pfVect[k];
- for(i=(k+1); i<nDim; i++)
+ for (k = (nDim - 1); k >= 0; k--)
{
- pfSolution[k] -= (pfMatr[k*nDim + i]*pfSolution[i]);
+ pfSolution[k] = pfVect[k];
+ for (i = (k + 1); i < nDim; i++)
+ {
+ pfSolution[k] -= (pfMatr[k * nDim + i] * pfSolution[i]);
+ }
+ pfSolution[k] = pfSolution[k] / pfMatr[k * nDim + k];
}
- pfSolution[k] = pfSolution[k] / pfMatr[k*nDim + k];
- }
return 0;
}
diff --git a/src/nicksrc/sortit.c b/src/nicksrc/sortit.c
index 3e66e90..0dd6089 100644
--- a/src/nicksrc/sortit.c
+++ b/src/nicksrc/sortit.c
@@ -8,200 +8,248 @@
/**
a simple sort routine
-*/
+ */
-static double *ttt ;
-static int *ittt ;
-static int **pttt ;
-static int plen=0 ;
-static int *porder = NULL ;
+static double *ttt;
+static int *ittt;
+static int **pttt;
+static int plen = 0;
+static int *porder = NULL;
-void setorder(int *pp, int rlen)
+void
+setorder (int *pp, int rlen)
{
- int *tt ;
-
- if (plen > 0) {
- if (porder != NULL) free(porder) ;
- }
-
- if (pp==NULL) {
- porder = NULL ;
- plen = rlen ;
- return ;
- }
- ZALLOC(porder, rlen, int) ;
- ZALLOC(tt, rlen, int) ;
- copyiarr(pp, tt, rlen) ;
- isortit(tt, porder, rlen) ;
- free(tt) ;
- plen = rlen ;
+ int *tt;
+
+ if (plen > 0)
+ {
+ if (porder != NULL)
+ free (porder);
+ }
+
+ if (pp == NULL)
+ {
+ porder = NULL;
+ plen = rlen;
+ return;
+ }
+ ZALLOC(porder, rlen, int);
+ ZALLOC(tt, rlen, int);
+ copyiarr (pp, tt, rlen);
+ isortit (tt, porder, rlen);
+ free (tt);
+ plen = rlen;
}
-double median(double *aa, int len)
+double
+median (double *aa, int len)
// should be O(len) algorithm
{
- double *b, y ;
- int t, x, a, n ;
-
- ZALLOC(b, len, double) ;
- n = 0 ;
- for (a=0; a<len; ++a) {
- y = aa[a] ;
- if (isfinite(y)) {
- b[n] = y ; ++n ;
- }
- }
- if (n==0) fatalx("(median) no valids\n") ;
- if (n==1) return b[0] ;
- if (n==2) return 0.5*(b[0]+b[1]) ;
- sortit(b, NULL, n) ;
- t = n % 2 ; x = n/2 ;
- y = b[x] ;
- if (t==0) y = 0.5*(b[x] + b[x-1]) ;
-
- free(b) ;
+ double *b, y;
+ int t, x, a, n;
+
+ ZALLOC(b, len, double);
+ n = 0;
+ for (a = 0; a < len; ++a)
+ {
+ y = aa[a];
+ if (isfinite(y))
+ {
+ b[n] = y;
+ ++n;
+ }
+ }
+ if (n == 0)
+ fatalx ("(median) no valids\n");
+ if (n == 1)
+ return b[0];
+ if (n == 2)
+ return 0.5 * (b[0] + b[1]);
+ sortit (b, NULL, n);
+ t = n % 2;
+ x = n / 2;
+ y = b[x];
+ if (t == 0)
+ y = 0.5 * (b[x] + b[x - 1]);
+
+ free (b);
// printf("zzmed: %d %d %d %9.3f\n", len, n, x, y) ;
- return y ;
-
+ return y;
}
-void sortit(double *a, int *ind, int len)
+void
+sortit (double *a, int *ind, int len)
{
- int i,k ;
- int *inda ;
-
- if (len==0) fatalx("(sortit) len = 0\n") ;
- ZALLOC(ttt, len, double) ;
- ZALLOC(inda, len, int) ;
-
- for (i=0; i<len; i++) {
- inda[i] = i ;
- }
-
- copyarr(a,ttt,len) ;
- qsort((int *) inda, len, sizeof(int), (int (*) (const void *, const void *)) compit);
-
- for (i=0; i<len; i++) {
- k = inda[i] ;
- a[i] = ttt[k] ;
- }
- free (ttt) ;
- if (ind != NULL) copyiarr(inda, ind, len) ;
- free(inda) ;
+ int i, k;
+ int *inda;
+
+ if (len == 0)
+ fatalx ("(sortit) len = 0\n");
+ ZALLOC(ttt, len, double);
+ ZALLOC(inda, len, int);
+
+ for (i = 0; i < len; i++)
+ {
+ inda[i] = i;
+ }
+
+ copyarr (a, ttt, len);
+ qsort ((int *) inda, len, sizeof(int), (int
+ (*) (const void *, const void *)) compit);
+
+ for (i = 0; i < len; i++)
+ {
+ k = inda[i];
+ a[i] = ttt[k];
+ }
+ free (ttt);
+ if (ind != NULL)
+ copyiarr (inda, ind, len);
+ free (inda);
}
-int compit (int *a1, int *a2)
+int
+compit (int *a1, int *a2)
{
- if (ttt[*a1] < ttt[*a2]) return -1 ;
- if (ttt[*a1] > ttt[*a2]) return 1 ;
- return 0 ;
+ if (ttt[*a1] < ttt[*a2])
+ return -1;
+ if (ttt[*a1] > ttt[*a2])
+ return 1;
+ return 0;
}
-void isortit(int *a, int *ind, int len)
+void
+isortit (int *a, int *ind, int len)
{
- int i,k ;
- int *inda ;
-
- if (len==0) fatalx("(isortit) len = 0\n") ;
- ZALLOC(ittt, len, int) ;
- ZALLOC(inda, len, int) ;
-
- for (i=0; i<len; i++) {
- inda[i] = i ;
- }
-
- copyiarr(a,ittt,len) ;
- qsort((int *) inda, len, sizeof(int), (int (*) (const void *, const void *)) icompit);
-
- for (i=0; i<len; i++) {
- k = inda[i] ;
- a[i] = ittt[k] ;
- }
- free (ittt) ;
- if (ind != NULL) copyiarr(inda, ind, len) ;
- free(inda) ;
+ int i, k;
+ int *inda;
+
+ if (len == 0)
+ fatalx ("(isortit) len = 0\n");
+ ZALLOC(ittt, len, int);
+ ZALLOC(inda, len, int);
+
+ for (i = 0; i < len; i++)
+ {
+ inda[i] = i;
+ }
+
+ copyiarr (a, ittt, len);
+ qsort ((int *) inda, len, sizeof(int), (int
+ (*) (const void *, const void *)) icompit);
+
+ for (i = 0; i < len; i++)
+ {
+ k = inda[i];
+ a[i] = ittt[k];
+ }
+ free (ittt);
+ if (ind != NULL)
+ copyiarr (inda, ind, len);
+ free (inda);
}
-int icompit (int *a1, int *a2)
+int
+icompit (int *a1, int *a2)
{
- if (ittt[*a1] < ittt[*a2]) return -1 ;
- if (ittt[*a1] > ittt[*a2]) return 1 ;
- return 0 ;
+ if (ittt[*a1] < ittt[*a2])
+ return -1;
+ if (ittt[*a1] > ittt[*a2])
+ return 1;
+ return 0;
}
-void invperm(int *a, int *b, int n) {
-/**
- a, b can be same
-*/
- int i, j ;
- int *x ;
-
- if (n==0) return ;
- ZALLOC(x, n, int) ;
-
- ivclear(x,-1,n) ;
- for (i=0; i<n; i++) {
- j=b[i] ;
- x[j]=i ;
- }
- copyiarr(x, a, n) ;
- free(x) ;
+void
+invperm (int *a, int *b, int n)
+{
+ /**
+ a, b can be same
+ */
+ int i, j;
+ int *x;
+
+ if (n == 0)
+ return;
+ ZALLOC(x, n, int);
+
+ ivclear (x, -1, n);
+ for (i = 0; i < n; i++)
+ {
+ j = b[i];
+ x[j] = i;
+ }
+ copyiarr (x, a, n);
+ free (x);
}
-void ipsortit(int **a, int *ind, int len, int rlen)
+void
+ipsortit (int **a, int *ind, int len, int rlen)
{
- ipsortitp(a, ind, len, rlen, NULL) ;
+ ipsortitp (a, ind, len, rlen, NULL);
}
-void ipsortitp(int **a, int *ind, int len, int rlen, int *order)
+void
+ipsortitp (int **a, int *ind, int len, int rlen, int *order)
/**
sort integer array pointers
rows of array are sorted in lexicographical order
compiarr can be called outside the sort
-*/
+ */
{
- int i,k ;
- int *inda ;
-
- if (len==0) fatalx("(ipsortit) len = 0\n") ;
- ZALLOC(pttt, len, int *) ;
- ZALLOC(inda, len, int) ;
-
- setorder(order, rlen) ; // order defines order as sorted in ascending order.
-
- for (i=0; i<len; i++) {
- if (a[i] == NULL) fatalx("(ipsortit) array pointer %d NULL\n",i) ;
- inda[i] = i ;
- }
-
- copyiparr(a,pttt,len) ;
- qsort((int *) inda, len,
- sizeof(int), (int (*) (const void *, const void *)) ipcompit);
-
- for (i=0; i<len; i++) {
- k = inda[i] ;
- a[i] = pttt[k] ;
- }
- if (ind != NULL) copyiarr(inda, ind, len) ;
- free(inda) ;
- free (pttt) ;
+ int i, k;
+ int *inda;
+
+ if (len == 0)
+ fatalx ("(ipsortit) len = 0\n");
+ ZALLOC(pttt, len, int *);
+ ZALLOC(inda, len, int);
+
+ setorder (order, rlen); // order defines order as sorted in ascending order.
+
+ for (i = 0; i < len; i++)
+ {
+ if (a[i] == NULL)
+ fatalx ("(ipsortit) array pointer %d NULL\n", i);
+ inda[i] = i;
+ }
+
+ copyiparr (a, pttt, len);
+ qsort ((int *) inda, len, sizeof(int), (int
+ (*) (const void *, const void *)) ipcompit);
+
+ for (i = 0; i < len; i++)
+ {
+ k = inda[i];
+ a[i] = pttt[k];
+ }
+ if (ind != NULL)
+ copyiarr (inda, ind, len);
+ free (inda);
+ free (pttt);
}
-int ipcompit (int *a1, int *a2)
+int
+ipcompit (int *a1, int *a2)
{
- int l ;
- l = compiarr(pttt[*a1], pttt[*a2], plen) ;
- return l ;
+ int l;
+ l = compiarr (pttt[*a1], pttt[*a2], plen);
+ return l;
}
-int compiarr(int *a, int *b, int len)
+int
+compiarr (int *a, int *b, int len)
{
- int i, k ;
- for (i=0; i<len; i++) {
- k = i ; if (porder != NULL) k = porder[i] ;
- if (a[k] < b[k]) return -1 ;
- if (a[k] > b[k]) return 1 ;
- }
- return 0 ;
+ int i, k;
+ for (i = 0; i < len; i++)
+ {
+ k = i;
+ if (porder != NULL)
+ k = porder[i];
+ if (a[k] < b[k])
+ return -1;
+ if (a[k] > b[k])
+ return 1;
+ }
+ return 0;
}
diff --git a/src/nicksrc/statsubs.c b/src/nicksrc/statsubs.c
index 0386f9b..83596d9 100644
--- a/src/nicksrc/statsubs.c
+++ b/src/nicksrc/statsubs.c
@@ -1,1962 +1,2333 @@
#include <stdio.h>
-#include <math.h>
+#include <math.h>
+#include <string.h>
+
+#include "statsubs.h"
+#include "vsubs.h"
+
+#include "twtable.h"
+
+#define EPS1 .001
+#define EPS2 1.0e-12
+#define ZLIM 20
+#define QSIZE 10
+
+static double *bern; /* bernouilli numbers */
+static int bernmax = 0;
+static double *ztable = NULL, *ptable = NULL;
+static double ptiny;
+static int numbox = QSIZE * ZLIM;
+
+static double
+zzprob (double zval);
+static double
+znewt (double z, double ptail);
+
+static double
+ltlg1 (double a, double x);
+static double
+ltlg2 (double a, double x);
+static double
+rtlg1 (double a, double x);
+static double
+rtlg2 (double a, double x);
+static double
+pochisq (double x, int df);
+static double
+pof (double F, int df1, int df2);
+static double
+betacf (double a, double b, double x);
+static void
+weightjackx (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g);
+
+static int twtabsize = -1;
+static double *twxval, *twxpdf, *twxtail;
+
+static char *twxtable = NULL;
+
+static double **bcotable = NULL;
+static int bcosize = -1; // max val of binomial coefficient
-#include "statsubs.h"
-#include "vsubs.h"
-
-#define EPS1 .001
-#define EPS2 1.0e-12
-#define ZLIM 20
-#define QSIZE 10
-
-
-static double *bern ; /* bernouilli numbers */
-static int bernmax = 0 ;
-static double *ztable = NULL, *ptable = NULL ;
-static double ptiny ;
-static int numbox = QSIZE*ZLIM ;
-
-
-
-static double zzprob(double zval) ;
-static double znewt(double z, double ptail) ;
-
-static double ltlg1(double a, double x) ;
-static double ltlg2(double a, double x) ;
-static double rtlg1(double a, double x) ;
-static double rtlg2(double a, double x) ;
-static double pochisq (double x, int df) ;
-static double pof (double F, int df1, int df2) ;
-static double betacf(double a, double b, double x) ;
-static void weightjackx(double *est, double *sig, double mean, double *jmean, double *jwt, int g) ;
-
-static int twtabsize = -1 ;
-static double *twxval, *twxpdf, *twxtail ;
-
-#define TWXTABLE TWTAB
-static char *twxtable = NULL ;
-
-static double **bcotable = NULL ;
-static int bcosize = -1 ; // max val of binomial coefficient
-
-
-double nordis(double zval)
+double
+nordis (double zval)
/* normal density */
{
- double pi, t ;
+ double pi, t;
- pi = 2.0*acos(0.0) ;
+ pi = 2.0 * acos (0.0);
- t = exp(-0.5*zval*zval) ;
- t /= sqrt(2.0*pi) ;
+ t = exp (-0.5 * zval * zval);
+ t /= sqrt (2.0 * pi);
- return t ;
+ return t;
}
-double ndens(double val, double mean, double sig)
+double
+ndens (double val, double mean, double sig)
{
- return nordis( (val-mean)/sig) /sig ;
+ return nordis ((val - mean) / sig) / sig;
}
-double ntail(double zval)
+double
+ntail (double zval)
/** normal distribution tail area
uses erfc
-*/
-
+ */
{
- double pi, t ;
- double p, q, d ;
+ double pi, t;
+ double p, q, d;
- if (zval == 0.0) return 0.5 ;
- if (zval<0.0) return (1.0 - ntail(-zval)) ;
- if (zval<ZLIM) {
- t = zval/sqrt(2.0) ;
- q = erfc(t)/2.0 ;
- return q ;
- }
+ if (zval == 0.0)
+ return 0.5;
+ if (zval < 0.0)
+ return (1.0 - ntail (-zval));
+ if (zval < ZLIM)
+ {
+ t = zval / sqrt (2.0);
+ q = erfc (t) / 2.0;
+ return q;
+ }
- pi = 2.0*acos(0.0) ;
+ pi = 2.0 * acos (0.0);
- t = exp(-0.5*zval*zval) ;
- t /= (sqrt(2.0*pi) * zval) ;
+ t = exp (-0.5 * zval * zval);
+ t /= (sqrt (2.0 * pi) * zval);
- return t ;
+ return t;
}
-double zzprob(double pval) {
- double x, dev, p, q, d, h, u ;
- double pi ;
- int iter ;
+double
+zzprob (double pval)
+{
+ double x, dev, p, q, d, h, u;
+ double pi;
+ int iter;
-/** approximate normal by 1/(sqrt 2 pi) * exp (-0.5*x*x) / x */
-/* Feller I page 166 */
+ /** approximate normal by 1/(sqrt 2 pi) * exp (-0.5*x*x) / x */
+ /* Feller I page 166 */
- if (pval==0.0) return 50.0 ;
+ if (pval == 0.0)
+ return 50.0;
- pi = 2.0*acos(0.0) ;
- u = -log(sqrt(2.0*pi)*pval) ;
-/* solve x*x/2 + log(x) = u */
+ pi = 2.0 * acos (0.0);
+ u = -log (sqrt (2.0 * pi) * pval);
+ /* solve x*x/2 + log(x) = u */
- x = sqrt(2.0*u) ;
- for (iter=1; iter<=10; ++iter) {
- q = (0.5*x*x) + log(x) ;
- d = x + (1.0/x) ;
- dev = u - q;
- h = dev/d ;
- x += h ;
- if (fabs(h)<1.0e-7) return x ;
- }
- return x ;
+ x = sqrt (2.0 * u);
+ for (iter = 1; iter <= 10; ++iter)
+ {
+ q = (0.5 * x * x) + log (x);
+ d = x + (1.0 / x);
+ dev = u - q;
+ h = dev / d;
+ x += h;
+ if (fabs (h) < 1.0e-7)
+ return x;
+ }
+ return x;
}
-double medchi(int *cls, int len, int *n0, int *n1, double *xtail)
+double
+medchi (int *cls, int len, int *n0, int *n1, double *xtail)
{
-/* compute 2x2 chisq splitting at median */
- int i, m0,m1,n,m ;
- double arr[4], y, ys, p, q, d ;
- *n0 = *n1 = 0 ;
- for (i=0; i<len; i++) {
- if (cls[i]>1) continue ;
- if (cls[i]<0) continue ;
- if (cls[i]==0) ++*n0 ;
- if (cls[i]==1) ++*n1 ;
- }
- if (MIN(*n0,*n1)==0) {
- *xtail = 1.0 ;
- return 0 ;
- }
- m = (*n0+*n1)/2 ;
- m0 = m1 = 0;
- for (i=0; i<len; i++) {
- if (cls[i]>1) continue ;
- if (cls[i]<0) continue ;
- if (cls[i]==0) ++m0 ;
- if (cls[i]==1) ++m1 ;
- if ((m0+m1) == m) break ;
- }
+ /* compute 2x2 chisq splitting at median */
+ int i, m0, m1, n, m;
+ double arr[4], y, ys, p, q, d;
+ *n0 = *n1 = 0;
+ for (i = 0; i < len; i++)
+ {
+ if (cls[i] > 1)
+ continue;
+ if (cls[i] < 0)
+ continue;
+ if (cls[i] == 0)
+ ++*n0;
+ if (cls[i] == 1)
+ ++*n1;
+ }
+ if (MIN (*n0, *n1) == 0)
+ {
+ *xtail = 1.0;
+ return 0;
+ }
+ m = (*n0 + *n1) / 2;
+ m0 = m1 = 0;
+ for (i = 0; i < len; i++)
+ {
+ if (cls[i] > 1)
+ continue;
+ if (cls[i] < 0)
+ continue;
+ if (cls[i] == 0)
+ ++m0;
+ if (cls[i] == 1)
+ ++m1;
+ if ((m0 + m1) == m)
+ break;
+ }
+
+ arr[0] = (double) m0;
+ arr[1] = (double) m1;
+ arr[2] = (double) (*n0 - m0);
+ arr[3] = (double) (*n1 - m1);
- arr[0] = (double) m0 ;
- arr[1] = (double) m1 ;
- arr[2] = (double) (*n0-m0) ;
- arr[3] = (double) (*n1-m1) ;
+ y = conchi (arr, 2, 2);
+ ys = sqrt (y + EPS2);
+ q = ntail (ys);
- y = conchi(arr,2,2) ;
- ys = sqrt(y+EPS2) ;
- q = ntail(ys) ;
-
- *xtail = q ;
+ *xtail = q;
- return y ;
+ return y;
}
-double ks2(int *cls, int len, int *n0, int *n1, double *kstail)
-{
-/*
- compute KS statistic
- cls should be 0 or 1. if larger take as invalid
-*/
- int i ;
- double en0, en1, en ;
- double y, ymax ;
-/* count class sizes */
-
- if (len <= 1) {
- *kstail = 1.0 ;
- return 0 ;
- }
-
- *n0 = *n1 = 0 ;
- for (i=0; i<len; i++) {
- if (cls[i]>1) continue ;
- if (cls[i]<0) continue ;
- if (cls[i]==0) ++*n0 ;
- if (cls[i]==1) ++*n1 ;
- }
- if (MIN(*n0,*n1)==0) {
-/**
- printf("warning ks2 has only 1 class passed\n") ;
- for (i=0; i<len ; i++) {
- printf("zz1 %d %d\n",i,cls[i]) ;
- }
-*/
- *kstail = 1.0 ;
- return 0 ;
- }
-
- en0 = (double) *n0 ;
- en1 = (double) *n1 ;
-
-
- ymax = y = 0.0 ; /* running stat */ ;
- for (i=0; i<len; i++) {
- if (cls[i]>1) continue ;
- if (cls[i]<0) continue ;
- if (cls[i]==0) y += 1.0/en0 ;
- if (cls[i]==1) y -= 1.0/en1 ;
- ymax = MAX(ymax,fabs(y)) ;
- }
-
-/* Numerical recipes p 626 */
- en = sqrt(en0*en1/(en0+en1)) ;
- y = en+.12+(0.11/en) ;
- y *= ymax ;
- *kstail = probks(y) ;
- return y ;
-/** crude analysis:
- variance of 1 step above is (1/n0 + 1/n1) / (n0+n1)
- and so variance of y is brownian motion not bridge is (1/n0+1/n1)
- We want to rescale y to correspond to Brownian bridge.
- First order correction is en. We actually use
+double
+ks2 (int *cls, int len, int *n0, int *n1, double *kstail)
+{
+ /*
+ compute KS statistic
+ cls should be 0 or 1. if larger take as invalid
+ */
+ int i;
+ double en0, en1, en;
+ double y, ymax;
+ /* count class sizes */
+
+ if (len <= 1)
+ {
+ *kstail = 1.0;
+ return 0;
+ }
+
+ *n0 = *n1 = 0;
+ for (i = 0; i < len; i++)
+ {
+ if (cls[i] > 1)
+ continue;
+ if (cls[i] < 0)
+ continue;
+ if (cls[i] == 0)
+ ++*n0;
+ if (cls[i] == 1)
+ ++*n1;
+ }
+ if (MIN (*n0, *n1) == 0)
+ {
+ /**
+ printf("warning ks2 has only 1 class passed\n") ;
+ for (i=0; i<len ; i++) {
+ printf("zz1 %d %d\n",i,cls[i]) ;
+ }
+ */
+ *kstail = 1.0;
+ return 0;
+ }
+
+ en0 = (double) *n0;
+ en1 = (double) *n1;
+
+ ymax = y = 0.0; /* running stat */
+ ;
+ for (i = 0; i < len; i++)
+ {
+ if (cls[i] > 1)
+ continue;
+ if (cls[i] < 0)
+ continue;
+ if (cls[i] == 0)
+ y += 1.0 / en0;
+ if (cls[i] == 1)
+ y -= 1.0 / en1;
+ ymax = MAX(ymax, fabs (y));
+ }
+
+ /* Numerical recipes p 626 */
+ en = sqrt (en0 * en1 / (en0 + en1));
+ y = en + .12 + (0.11 / en);
+ y *= ymax;
+ *kstail = probks (y);
+ return y;
+ /** crude analysis:
+ variance of 1 step above is (1/n0 + 1/n1) / (n0+n1)
+ and so variance of y is brownian motion not bridge is (1/n0+1/n1)
+ We want to rescale y to correspond to Brownian bridge.
+ First order correction is en. We actually use
a Bartlett correction of some sort
- Normalized y seems like what to return.
-*/
+ Normalized y seems like what to return.
+ */
}
-double probks(double lam)
+double
+probks (double lam)
/* KS tail area: Numerical recipes p 626 */
{
- int j ;
- double a2, fac=2.0, sum=0.0, term, termbf=0.0 ;
- double t ;
+ int j;
+ double a2, fac = 2.0, sum = 0.0, term, termbf = 0.0;
+ double t;
- a2 = -2.0*lam*lam ;
- for (j=1; j<=100; j++) {
- t = a2* (double) (j*j) ;
- term = fac*exp(t) ;
- sum += term ;
- t = fabs(term) ;
- if ((t <= EPS1*termbf) || ( t <= EPS2*sum)) return sum ;
- fac = -fac ;
- termbf = fabs(term) ;
- }
- return 1.0 ;
+ a2 = -2.0 * lam * lam;
+ for (j = 1; j <= 100; j++)
+ {
+ t = a2 * (double) (j * j);
+ term = fac * exp (t);
+ sum += term;
+ t = fabs (term);
+ if ((t <= EPS1 * termbf) || (t <= EPS2 * sum))
+ return sum;
+ fac = -fac;
+ termbf = fabs (term);
+ }
+ return 1.0;
}
-double conchiv(double *a, int m, int n)
+double
+conchiv (double *a, int m, int n)
/* a is m rows n columns. contingency chisq */
{
- double *rsum, *csum, ee, tot=0, chsq=0, y ;
- int i,j,k ;
-
- ZALLOC(rsum,m,double) ;
- ZALLOC(csum,n,double) ;
-
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- rsum[i] += a[k] ;
- csum[j] += a[k] ;
- tot += a[k] ;
- }
- }
- if (tot < 0.001)
- fatalx("(conchiv) no data\n") ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- ee = rsum[i]*csum[j]/tot ;
- if (ee < EPS2) {
- printf("bad conchi\n") ;
- printmat(a, m, n) ;
- fatalx("(conchiv) zero row or column sum\n") ;
- }
- y = a[k]-ee ;
- printf("conchiv: %4d %4d ", i,j) ;
- printf("%9.3f ", a[k]) ;
- printf("%9.3f ", ee) ;
- printf("%9.3f ", y) ;
- printf("%9.3f ", y/sqrt(ee)) ;
- printnl() ;
- chsq += (y*y)/ee ;
- }
- }
- free(rsum) ; free(csum) ;
- return chsq ;
-}
-
-double z2x2(double *a)
+ double *rsum, *csum, ee, tot = 0, chsq = 0, y;
+ int i, j, k;
+
+ ZALLOC(rsum, m, double);
+ ZALLOC(csum, n, double);
+
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ rsum[i] += a[k];
+ csum[j] += a[k];
+ tot += a[k];
+ }
+ }
+ if (tot < 0.001)
+ fatalx ("(conchiv) no data\n");
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ ee = rsum[i] * csum[j] / tot;
+ if (ee < EPS2)
+ {
+ printf ("bad conchi\n");
+ printmat (a, m, n);
+ fatalx ("(conchiv) zero row or column sum\n");
+ }
+ y = a[k] - ee;
+ printf ("conchiv: %4d %4d ", i, j);
+ printf ("%9.3f ", a[k]);
+ printf ("%9.3f ", ee);
+ printf ("%9.3f ", y);
+ printf ("%9.3f ", y / sqrt (ee));
+ printnl ();
+ chsq += (y * y) / ee;
+ }
+ }
+ free (rsum);
+ free (csum);
+ return chsq;
+}
+
+double
+z2x2 (double *a)
/* a is 2 rows 2 columns. contingency z-score */
{
- double *rsum, *csum, ee, tot=0, chsq=0, y, dev00, z ;
- int i,j,k,m=2, n=2 ;
-
- ZALLOC(rsum,m,double) ;
- ZALLOC(csum,n,double) ;
-
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- rsum[i] += a[k] ;
- csum[j] += a[k] ;
- tot += a[k] ;
- }
- }
- if (tot < 0.001)
- fatalx("(z2x2) no data\n") ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- ee = rsum[i]*csum[j]/tot ;
- if (ee < EPS2) {
- printf("bad conchi\n") ;
- printmat(a, m, n) ;
- fatalx("(conchi) zero row or column sum\n") ;
- }
- y = a[k]-ee ;
- if (k == 0) dev00 = y ;
- chsq += (y*y)/ee ;
- }
- }
- z = sqrt(chsq + 1.0e-12) ;
- if (dev00 < 0.0) z = -z ;
- free(rsum) ; free(csum) ;
- return z ;
-}
+ double *rsum, *csum, ee, tot = 0, chsq = 0, y, dev00, z;
+ int i, j, k, m = 2, n = 2;
+
+ ZALLOC(rsum, m, double);
+ ZALLOC(csum, n, double);
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ rsum[i] += a[k];
+ csum[j] += a[k];
+ tot += a[k];
+ }
+ }
+ if (tot < 0.001)
+ fatalx ("(z2x2) no data\n");
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ ee = rsum[i] * csum[j] / tot;
+ if (ee < EPS2)
+ {
+ printf ("bad conchi\n");
+ printmat (a, m, n);
+ fatalx ("(conchi) zero row or column sum\n");
+ }
+ y = a[k] - ee;
+ if (k == 0)
+ dev00 = y;
+ chsq += (y * y) / ee;
+ }
+ }
+ z = sqrt (chsq + 1.0e-12);
+ if (dev00 < 0.0)
+ z = -z;
+ free (rsum);
+ free (csum);
+ return z;
+}
-double conchi(double *a, int m, int n)
+double
+conchi (double *a, int m, int n)
/* a is m rows n columns. contingency chisq */
{
- double *rsum, *csum, ee, tot=0, chsq=0, y ;
- int i,j,k ;
-
- ZALLOC(rsum,m,double) ;
- ZALLOC(csum,n,double) ;
-
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- rsum[i] += a[k] ;
- csum[j] += a[k] ;
- tot += a[k] ;
- }
- }
- if (tot < 0.001)
- fatalx("(conchi) no data\n") ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- k = i*n+j ;
- ee = rsum[i]*csum[j]/tot ;
- if (ee < EPS2) {
- printf("bad conchi\n") ;
- printmat(a, m, n) ;
- fatalx("(conchi) zero row or column sum\n") ;
- }
- y = a[k]-ee ;
- chsq += (y*y)/ee ;
- }
- }
- free(rsum) ; free(csum) ;
- return chsq ;
+ double *rsum, *csum, ee, tot = 0, chsq = 0, y;
+ int i, j, k;
+
+ ZALLOC(rsum, m, double);
+ ZALLOC(csum, n, double);
+
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ rsum[i] += a[k];
+ csum[j] += a[k];
+ tot += a[k];
+ }
+ }
+ if (tot < 0.001)
+ fatalx ("(conchi) no data\n");
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ k = i * n + j;
+ ee = rsum[i] * csum[j] / tot;
+ if (ee < EPS2)
+ {
+ printf ("bad conchi\n");
+ printmat (a, m, n);
+ fatalx ("(conchi) zero row or column sum\n");
+ }
+ y = a[k] - ee;
+ chsq += (y * y) / ee;
+ }
+ }
+ free (rsum);
+ free (csum);
+ return chsq;
}
-double chitest(double *a, double *p, int n)
+double
+chitest (double *a, double *p, int n)
/* a is n boxes. Goodness of fit test to p */
{
-
- double *x, *b, *pp ;
- double y1=0.0, y2=0.0 ;
- int i ;
- ZALLOC(pp, n, double) ;
- if (p != NULL)
- copyarr(p,pp,n) ;
- else
- vclear(pp, 1.0, n) ;
+ double *x, *b, *pp;
+ double y1 = 0.0, y2 = 0.0;
+ int i;
- y1 = asum(pp,n) ;
- y2 = asum(a,n) ;
+ ZALLOC(pp, n, double);
+ if (p != NULL)
+ copyarr (p, pp, n);
+ else
+ vclear (pp, 1.0, n);
- if ( (y1==0.0) || (y2==0.0) ) {
- free(pp) ;
- return 0.0 ;
- }
+ y1 = asum (pp, n);
+ y2 = asum (a, n);
- ZALLOC(x,n,double) ;
- ZALLOC(b,n,double) ;
+ if ((y1 == 0.0) || (y2 == 0.0))
+ {
+ free (pp);
+ return 0.0;
+ }
+ ZALLOC(x, n, double);
+ ZALLOC(b, n, double);
- vst (x, pp, y2/y1, n) ; /* expected */
+ vst (x, pp, y2 / y1, n); /* expected */
- vsp (x, x, .0001, n) ;
- vvm (b, a, x, n) ;
- vvt (b, b, b, n) ;
- vvd (b, b, x, n) ;
+ vsp (x, x, .0001, n);
+ vvm (b, a, x, n);
+ vvt (b, b, b, n);
+ vvd (b, b, x, n);
- y1 = asum(b,n) ;
+ y1 = asum (b, n);
- free(x) ;
- free(b) ;
+ free (x);
+ free (b);
- return y1 ;
+ return y1;
}
-double zprob(double ptail)
+
+double
+zprob (double ptail)
/** inverse normal */
{
- double z, p, t, plog;
- double ylo, yhi, ya, yb ;
- int i, k ;
-
- if (ztable == NULL) setzptable() ;
- if (ptail==0.5) return 0.0 ;
- if (ptail>0.5) {
- z = zprob(1.0-ptail) ;
- return -z ;
- }
- if ((ptail>.40) && (ptail < .50)) return znewt(0.0, ptail) ;
- if (ptail<ptiny) {
- z = zzprob(ptail) ;
- return znewt(z,ptail) ;
- }
-/** replace by binary or interpolating search */
- plog = -log(ptail) ;
- k = firstgt(plog, ptable, numbox) ;
- if (k==0) return ztable[0] ;
- if (k==numbox) return ztable[numbox-1] ;
- ylo = ptable[k-1] ;
- yhi = ptable[k] ;
- ya = (yhi-plog) ;
- yb = plog-ylo ;
- z = (ya*ztable[k-1]+yb*ztable[k])/(ya+yb) ;
- if (isnan(z)) fatalx("zprob bug %15.9f %15.9f\n", z, ptail) ;
- t = znewt(z, ptail) ;
- if (isnan(t)) fatalx("zprob bug %15.9f %15.9f\n", z, ptail) ;
- return t ;
-}
-
-void setzptable()
-{
- int i ;
- double p, z ;
- if (ptable != NULL) free(ptable) ;
- if (ztable != NULL) free(ztable) ;
- ZALLOC(ptable, numbox, double) ;
- ZALLOC(ztable, numbox, double) ;
- z = 0.0 ;
- for ( i=0; i<numbox; i++) {
- p = ntail(z) ;
- ztable[i] = z ;
- ptable[i] = -log(p) ;
- z += 1.0/(double) QSIZE ;
- }
- ptiny = p ;
-}
-
-double znewt(double z, double ptail)
+ double z, p, t, plog;
+ double ylo, yhi, ya, yb;
+ int i, k;
+
+ if (ztable == NULL)
+ setzptable ();
+ if (ptail == 0.5)
+ return 0.0;
+ if (ptail > 0.5)
+ {
+ z = zprob (1.0 - ptail);
+ return -z;
+ }
+ if ((ptail > .40) && (ptail < .50))
+ return znewt (0.0, ptail);
+ if (ptail < ptiny)
+ {
+ z = zzprob (ptail);
+ return znewt (z, ptail);
+ }
+ /** replace by binary or interpolating search */
+ plog = -log (ptail);
+ k = firstgt (plog, ptable, numbox);
+ if (k == 0)
+ return ztable[0];
+ if (k == numbox)
+ return ztable[numbox - 1];
+ ylo = ptable[k - 1];
+ yhi = ptable[k];
+ ya = (yhi - plog);
+ yb = plog - ylo;
+ z = (ya * ztable[k - 1] + yb * ztable[k]) / (ya + yb);
+ if (isnan(z))
+ fatalx ("zprob bug %15.9f %15.9f\n", z, ptail);
+ t = znewt (z, ptail);
+ if (isnan(t))
+ fatalx ("zprob bug %15.9f %15.9f\n", z, ptail);
+ return t;
+}
+
+void
+setzptable ()
+{
+ int i;
+ double p, z;
+ if (ptable != NULL)
+ free (ptable);
+ if (ztable != NULL)
+ free (ztable);
+ ZALLOC(ptable, numbox, double);
+ ZALLOC(ztable, numbox, double);
+ z = 0.0;
+ for (i = 0; i < numbox; i++)
+ {
+ p = ntail (z);
+ ztable[i] = z;
+ ptable[i] = -log (p);
+ z += 1.0 / (double) QSIZE;
+ }
+ ptiny = p;
+}
+
+double
+znewt (double z, double ptail)
+{
+ /**
+ newton step
+ z is very good approximation
+ */
+ double p0, pder, h;
+ double pi, zz;
+ int iter;
+ pi = 2.0 * acos (0.0);
+ zz = z;
+ for (iter = 1; iter <= 5; ++iter)
+ {
+ p0 = ntail (zz);
+ pder = -exp (-0.5 * zz * zz) / sqrt (2 * pi);
+ if (pder == 0.0)
+ return zz;
+ h = (ptail - p0) / pder;
+ if (fabs (h) <= 1.0e-10)
+ return zz;
+ zz += h;
+ }
+ return zz;
+}
+
+int
+ifirstgt (int val, int *tab, int n)
{
-/**
- newton step
- z is very good approximation
-*/
- double p0, pder, h ;
- double pi, zz ;
- int iter ;
- pi = 2.0*acos(0.0) ;
- zz = z ;
- for (iter = 1; iter<=5; ++iter) {
- p0 = ntail(zz) ;
- pder = -exp(-0.5*zz*zz)/sqrt(2*pi) ;
- if (pder==0.0) return zz ;
- h = (ptail-p0)/pder ;
- if (fabs(h)<=1.0e-10) return zz ;
- zz += h ;
+ /* tab sorted in ascending order */
+ int i;
+
+ if (val >= tab[n - 1])
+ return n;
+ for (i = 0; i < n; i++)
+ {
+ if (val < tab[i])
+ return i;
}
- return zz ;
}
-int ifirstgt(int val, int *tab, int n)
+
+int
+firstgt (double val, double *tab, int n)
{
-/* tab sorted in ascending order */
- int i ;
+ /* tab sorted in ascending order */
+ int i;
- if (val>=tab[n-1]) return n ;
- for (i=0; i<n; i++) {
- if (val<tab[i]) return i ;
- }
+ if (val >= tab[n - 1])
+ return n;
+ for (i = 0; i < n; i++)
+ {
+ if (val < tab[i])
+ return i;
+ }
}
-int firstgt(double val, double *tab, int n)
+void
+mleg (double a1, double a2, double *p, double *lam)
{
-/* tab sorted in ascending order */
- int i ;
+ int iter;
+ double s, pp, ll;
+ double top, bot, fval;
+ int debug = NO;
+
+ /**
+ solve
+ p/lam = a1 ; psi(p) - log(lam) = a2 ;
+ Thus psi(p) - log(p) = a2 - log(a1)
+ */
+ s = a2 - log (a1);
- if (val>=tab[n-1]) return n ;
- for (i=0; i<n; i++) {
- if (val<tab[i]) return i ;
- }
+ if (s >= 0.0)
+ fatalx ("log E(x) < E(log (x)) \n");
+ pp = -s;
+
+ for (iter = 1; iter <= 30; ++iter)
+ {
+ fval = s - (psi (pp) - log (pp));
+ if (debug)
+ printf ("yy1 %3d %9.3f %9.3f\n", iter, pp, fval);
+ if (fval < 0.0)
+ break;
+ pp *= 2.0;
+ }
+
+ for (iter = 1; iter <= 30; ++iter)
+ {
+ fval = s - (psi (pp) - log (pp));
+ if (fval > 0.0)
+ break;
+ if (debug)
+ printf ("yy2 %3d %9.3f %9.3f\n", iter, pp, fval);
+ pp /= 2.0;
+ }
+
+ for (iter = 1; iter <= 10; ++iter)
+ {
+ fval = psi (pp) - log (pp);
+ top = s - fval;
+ bot = tau (pp) - (1.0 / pp);
+ if (debug)
+ printf ("%3d %12.6f %12.6f\n", iter, pp, top);
+ pp += top / bot;
+ }
+ ll = pp / a1;
+ *p = pp;
+ *lam = ll;
}
-void mleg(double a1, double a2, double *p, double *lam)
+double
+psi (double x)
{
- int iter ;
- double s, pp, ll ;
- double top, bot, fval ;
- int debug = NO ;
+ double y, zz, term;
+ int k;
-/**
- solve
- p/lam = a1 ; psi(p) - log(lam) = a2 ;
- Thus psi(p) - log(p) = a2 - log(a1)
-*/
- s = a2 - log(a1) ;
-
- if (s>=0.0) fatalx("log E(x) < E(log (x)) \n") ;
- pp = -s ;
-
- for (iter = 1; iter <= 30 ; ++iter) {
- fval = s - (psi(pp) - log (pp)) ;
- if (debug)
- printf("yy1 %3d %9.3f %9.3f\n",iter,pp,fval) ;
- if (fval<0.0) break ;
- pp *= 2.0 ;
- }
-
- for (iter = 1; iter <= 30 ; ++iter) {
- fval = s - (psi(pp) - log (pp)) ;
- if (fval>0.0) break ;
- if (debug)
- printf("yy2 %3d %9.3f %9.3f\n",iter,pp,fval) ;
- pp /= 2.0 ;
- }
-
- for (iter = 1; iter <= 10 ; ++iter) {
- fval = psi(pp) - log (pp) ;
- top = s-fval ;
- bot = tau(pp) - (1.0/pp) ;
- if (debug)
- printf("%3d %12.6f %12.6f\n",iter,pp,top) ;
- pp += top/bot ;
- }
- ll = pp/a1 ;
- *p = pp ;
- *lam = ll ;
-}
-
-
-double psi(double x)
-{
- double y, zz, term ;
- int k ;
-
- if (x<=0.0) fatalx("(psi) bad value: %9.3f\n", x) ;
- bernload() ;
- if (x<10.0) return (psi(x+1.0) - 1.0/x) ;
-
- y = log(x) - 1.0/(2.0*x) ;
- zz = 1.0 ;
- for (k=1; k<= bernmax/2 ; k++) {
- zz /= (x*x) ;
- term = bernum(2*k)/(double) (2*k) ;
- term *= zz ;
- y -= term ;
- }
- return y ;
-}
-
-double tau(double x)
+ if (x <= 0.0)
+ fatalx ("(psi) bad value: %9.3f\n", x);
+ bernload ();
+ if (x < 10.0)
+ return (psi (x + 1.0) - 1.0 / x);
+
+ y = log (x) - 1.0 / (2.0 * x);
+ zz = 1.0;
+ for (k = 1; k <= bernmax / 2; k++)
+ {
+ zz /= (x * x);
+ term = bernum (2 * k) / (double) (2 * k);
+ term *= zz;
+ y -= term;
+ }
+ return y;
+}
+
+double
+tau (double x)
/*
derivative of psi
-*/
+ */
{
- double y, zz, term ;
- int k ;
+ double y, zz, term;
+ int k;
- if (x<=0.0) fatalx("(tau) bad value: %9.3f\n", x) ;
- bernload() ;
- if (x<10.0) return (tau(x+1.0) + 1.0/(x*x)) ;
+ if (x <= 0.0)
+ fatalx ("(tau) bad value: %9.3f\n", x);
+ bernload ();
+ if (x < 10.0)
+ return (tau (x + 1.0) + 1.0 / (x * x));
- y = 1.0/x + 1.0/(2.0*x*x) ;
- zz = 1.0/x ;
- for (k=1; k<= bernmax/2 ; k++) {
- zz /= (x*x) ;
- term = bernum(2*k)/(double) (2*k) ;
- term *= zz ;
- term *= - (double) (2*k) ;
- y -= term ;
- }
- return y ;
+ y = 1.0 / x + 1.0 / (2.0 * x * x);
+ zz = 1.0 / x;
+ for (k = 1; k <= bernmax / 2; k++)
+ {
+ zz /= (x * x);
+ term = bernum (2 * k) / (double) (2 * k);
+ term *= zz;
+ term *= -(double) (2 * k);
+ y -= term;
+ }
+ return y;
}
// Formulae from A + S p 374
-double logbessi1( double x)
-{
- double yans,logyans;
- double y;
-
-
- if (x<0.0) fatalx("bad bessi1\n") ;
- if (x < 3.75) {
- y=x/3.75,y=y*y;
- yans=x*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934
- +y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3))))));
- logyans = log(yans) ;
- } else {
- y=3.75/x;
- yans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1
- -y*0.420059e-2));
- yans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2
- +y*(0.163801e-2+y*(-0.1031555e-1+y*yans))));
- logyans = log(yans) ;
- logyans += x ; logyans -= log(x)/2 ;
- }
- return logyans ;
-}
-
-
+double
+logbessi1 (double x)
+{
+ double yans, logyans;
+ double y;
+ if (x < 0.0)
+ fatalx ("bad bessi1\n");
+ if (x < 3.75)
+ {
+ y = x / 3.75, y = y * y;
+ yans = x
+ * (0.5
+ + y
+ * (0.87890594
+ + y
+ * (0.51498869
+ + y
+ * (0.15084934
+ + y
+ * (0.2658733e-1
+ + y
+ * (0.301532e-2
+ + y * 0.32411e-3))))));
+ logyans = log (yans);
+ }
+ else
+ {
+ y = 3.75 / x;
+ yans = 0.2282967e-1
+ + y * (-0.2895312e-1 + y * (0.1787654e-1 - y * 0.420059e-2));
+ yans =
+ 0.39894228
+ + y
+ * (-0.3988024e-1
+ + y
+ * (-0.362018e-2
+ + y
+ * (0.163801e-2
+ + y * (-0.1031555e-1 + y * yans))));
+ logyans = log (yans);
+ logyans += x;
+ logyans -= log (x) / 2;
+ }
+ return logyans;
+}
-double bessi1( double x)
+double
+bessi1 (double x)
// I1(x)
{
- double yans;
- double y;
-
-
- if (x<0.0) fatalx("bad bessi1\n") ;
- if (x < 3.75) {
- y=x/3.75,y=y*y;
- yans=x*(0.5+y*(0.87890594+y*(0.51498869+y*(0.15084934
- +y*(0.2658733e-1+y*(0.301532e-2+y*0.32411e-3))))));
- } else {
- y=3.75/x;
- yans=0.2282967e-1+y*(-0.2895312e-1+y*(0.1787654e-1
- -y*0.420059e-2));
- yans=0.39894228+y*(-0.3988024e-1+y*(-0.362018e-2
- +y*(0.163801e-2+y*(-0.1031555e-1+y*yans))));
- yans *= exp(x)/sqrt(x);
- }
- return yans;
+ double yans;
+ double y;
+
+ if (x < 0.0)
+ fatalx ("bad bessi1\n");
+ if (x < 3.75)
+ {
+ y = x / 3.75, y = y * y;
+ yans = x
+ * (0.5
+ + y
+ * (0.87890594
+ + y
+ * (0.51498869
+ + y
+ * (0.15084934
+ + y
+ * (0.2658733e-1
+ + y
+ * (0.301532e-2
+ + y * 0.32411e-3))))));
+ }
+ else
+ {
+ y = 3.75 / x;
+ yans = 0.2282967e-1
+ + y * (-0.2895312e-1 + y * (0.1787654e-1 - y * 0.420059e-2));
+ yans =
+ 0.39894228
+ + y
+ * (-0.3988024e-1
+ + y
+ * (-0.362018e-2
+ + y
+ * (0.163801e-2
+ + y * (-0.1031555e-1 + y * yans))));
+ yans *= exp (x) / sqrt (x);
+ }
+ return yans;
}
-double logbessi0( double x )
+double
+logbessi0 (double x)
{
// log I0(x)
- double yans, logyans;
- double y;
-
- if (x<0.0) fatalx("bad bessi0\n") ;
-
- if (x < 3.75) {
- y=x/3.75,y=y*y;
- yans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492
- +y*(0.2659732+y*(0.360768e-1+y*0.45813e-2)))));
- logyans = log(yans) ;
- } else {
- y=3.75/x;
- yans=0.39894228+y*(0.1328592e-1
- +y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2
- +y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1
- +y*0.392377e-2)))))));
- logyans = log(yans) ;
- logyans += x ; logyans -= log(x)/2 ;
- }
- return logyans;
-}
+ double yans, logyans;
+ double y;
+
+ if (x < 0.0)
+ fatalx ("bad bessi0\n");
+ if (x < 3.75)
+ {
+ y = x / 3.75, y = y * y;
+ yans =
+ 1.0
+ + y
+ * (3.5156229
+ + y
+ * (3.0899424
+ + y
+ * (1.2067492
+ + y
+ * (0.2659732
+ + y
+ * (0.360768e-1
+ + y * 0.45813e-2)))));
+ logyans = log (yans);
+ }
+ else
+ {
+ y = 3.75 / x;
+ yans =
+ 0.39894228
+ + y
+ * (0.1328592e-1
+ + y
+ * (0.225319e-2
+ + y
+ * (-0.157565e-2
+ + y
+ * (0.916281e-2
+ + y
+ * (-0.2057706e-1
+ + y
+ * (0.2635537e-1
+ + y
+ * (-0.1647633e-1
+ + y
+ * 0.392377e-2)))))));
+ logyans = log (yans);
+ logyans += x;
+ logyans -= log (x) / 2;
+ }
+ return logyans;
+}
-double bessi0( double x )
+double
+bessi0 (double x)
{
// I0(x)
- double ans;
- double y;
-
- if (x<0.0) fatalx("bad bessi0\n") ;
-
- if (x < 3.75) {
- y=x/3.75,y=y*y;
- ans=1.0+y*(3.5156229+y*(3.0899424+y*(1.2067492
- +y*(0.2659732+y*(0.360768e-1+y*0.45813e-2)))));
- } else {
- y=3.75/x;
- ans=0.39894228+y*(0.1328592e-1
- +y*(0.225319e-2+y*(-0.157565e-2+y*(0.916281e-2
- +y*(-0.2057706e-1+y*(0.2635537e-1+y*(-0.1647633e-1
- +y*0.392377e-2)))))));
- ans *= exp(x)/sqrt(x);
- }
- return ans;
-}
-
+ double ans;
+ double y;
+ if (x < 0.0)
+ fatalx ("bad bessi0\n");
+ if (x < 3.75)
+ {
+ y = x / 3.75, y = y * y;
+ ans =
+ 1.0
+ + y
+ * (3.5156229
+ + y
+ * (3.0899424
+ + y
+ * (1.2067492
+ + y
+ * (0.2659732
+ + y
+ * (0.360768e-1
+ + y * 0.45813e-2)))));
+ }
+ else
+ {
+ y = 3.75 / x;
+ ans =
+ 0.39894228
+ + y
+ * (0.1328592e-1
+ + y
+ * (0.225319e-2
+ + y
+ * (-0.157565e-2
+ + y
+ * (0.916281e-2
+ + y
+ * (-0.2057706e-1
+ + y
+ * (0.2635537e-1
+ + y
+ * (-0.1647633e-1
+ + y
+ * 0.392377e-2)))))));
+ ans *= exp (x) / sqrt (x);
+ }
+ return ans;
+}
-void bernload()
-{
- if (bernmax>0) return ;
- bernmax = 14 ;
- ZALLOC(bern, bernmax+1, double) ;
- bern[0] = 1.0 ;
- bern[1] = -1.0/2.0 ;
- bern[2] = 1.0/6.0 ;
- bern[4] = -1.0/30.0 ;
- bern[6] = 1.0/42.0 ;
- bern[8] = -1.0/30.0 ;
- bern[10] = 5.0/66.0 ;
- bern[12] = -691.0/2730.0 ;
- bern[14] = 7.0/6.0 ;
+void
+bernload ()
+{
+ if (bernmax > 0)
+ return;
+ bernmax = 14;
+ ZALLOC(bern, bernmax + 1, double);
+ bern[0] = 1.0;
+ bern[1] = -1.0 / 2.0;
+ bern[2] = 1.0 / 6.0;
+ bern[4] = -1.0 / 30.0;
+ bern[6] = 1.0 / 42.0;
+ bern[8] = -1.0 / 30.0;
+ bern[10] = 5.0 / 66.0;
+ bern[12] = -691.0 / 2730.0;
+ bern[14] = 7.0 / 6.0;
}
-double bernum(int k)
+
+double
+bernum (int k)
{
- bernload() ;
- if ((k<0) || (k>bernmax)) fatalx("(bernum) bad arg: %s\n",k) ;
- return (bern[k]) ;
+ bernload ();
+ if ((k < 0) || (k > bernmax))
+ fatalx ("(bernum) bad arg: %s\n", k);
+ return (bern[k]);
}
-double dilog(double x)
+double
+dilog (double x)
{
- return li2(x) ;
+ return li2 (x);
}
-double li2(double x)
+double
+li2 (double x)
{
- double pi, sum=0.0, term, top, z ;
- int k ;
+ double pi, sum = 0.0, term, top, z;
+ int k;
- pi = acos(0.0)*2.0 ;
- if (x<=0.0) return pi*pi/6.0 ;
- if (x>=1.0) return 0 ;
- if (x<0.5) {
- return (-log(x)*log(1-x) + (pi*pi/6.0) -li2(1.0-x)) ;
- }
- z = 1-x ;
- top = 1.0 ;
- for (k=1; k<= 100; k++) {
- top *= z ;
- term = top/(double) (k*k) ;
- sum += term ;
- if (term <= 1.0e-20) break ;
- }
- return sum ;
+ pi = acos (0.0) * 2.0;
+ if (x <= 0.0)
+ return pi * pi / 6.0;
+ if (x >= 1.0)
+ return 0;
+ if (x < 0.5)
+ {
+ return (-log (x) * log (1 - x) + (pi * pi / 6.0) - li2 (1.0 - x));
+ }
+ z = 1 - x;
+ top = 1.0;
+ for (k = 1; k <= 100; k++)
+ {
+ top *= z;
+ term = top / (double) (k * k);
+ sum += term;
+ if (term <= 1.0e-20)
+ break;
+ }
+ return sum;
}
-double hwstat(double *x)
+double
+hwstat (double *x)
/** Hardy-Weinberg equilibrium test
- returns standard normal in null case.
- +sign is excess heterozygosity
- x[0] [1] [2] are counts for homozm hetero homo (alt allele)
-*/
+ returns standard normal in null case.
+ +sign is excess heterozygosity
+ x[0] [1] [2] are counts for homozm hetero homo (alt allele)
+ */
{
- double p, q, ysum, s1, y1, y2, ychi, sig ;
- double a1[3], a2[3] ;
+ double p, q, ysum, s1, y1, y2, ychi, sig;
+ double a1[3], a2[3];
- ysum = asum(x,3) ;
- if (ysum < 0.001) return 0.0 ;
- s1 = 2*x[2]+x[1] ;
- p = 0.5*s1/ysum;
- q = 1.0-p ;
+ ysum = asum (x, 3);
+ if (ysum < 0.001)
+ return 0.0;
+ s1 = 2 * x[2] + x[1];
+ p = 0.5 * s1 / ysum;
+ q = 1.0 - p;
- a1 [0] = q*q ;
- a1 [1] = 2*p*q ;
- a1 [2] = p*p ;
+ a1[0] = q * q;
+ a1[1] = 2 * p * q;
+ a1[2] = p * p;
- vsp(a1, a1, 1.0e-8, 3) ;
- vst(a2, x, 1.0/ysum, 3) ;
- vsp(a2, a2, 1.0e-8, 3) ;
+ vsp (a1, a1, 1.0e-8, 3);
+ vst (a2, x, 1.0 / ysum, 3);
+ vsp (a2, a2, 1.0e-8, 3);
- y2 = vldot(x, a2, 3) ;
- y1 = vldot(x, a1, 3) ;
+ y2 = vldot (x, a2, 3);
+ y1 = vldot (x, a1, 3);
- ychi = 2.0*(y2-y1) ;
- sig = sqrt(ychi+1.0e-8) ;
+ ychi = 2.0 * (y2 - y1);
+ sig = sqrt (ychi + 1.0e-8);
- if (a2[1]<a1[1]) sig = -sig ;
-/* negative => hets lo */
+ if (a2[1] < a1[1])
+ sig = -sig;
+ /* negative => hets lo */
- return sig ;
-
+ return sig;
}
-double bprob(double p, double a, double b)
+double
+bprob (double p, double a, double b)
{
- double q, yl ;
- q = 1.0 - p ;
- yl = (a-1) * log(p) + (b-1) * log (q) ;
- if (!finite(yl)) fatalx("bad bprob %9.3f %9.3f %9.3f\n", p, a, b) ;
- yl -= lbeta(a, b) ;
- if (!finite(yl)) fatalx("bad bprob (lbeta) %9.3f %9.3f %9.3f\n", p, a, b) ;
- return yl ;
+ double q, yl;
+ q = 1.0 - p;
+ yl = (a - 1) * log (p) + (b - 1) * log (q);
+ if (!finite (yl))
+ fatalx ("bad bprob %9.3f %9.3f %9.3f\n", p, a, b);
+ yl -= lbeta (a, b);
+ if (!finite (yl))
+ fatalx ("bad bprob (lbeta) %9.3f %9.3f %9.3f\n", p, a, b);
+ return yl;
}
-double gammprob(double x, double p, double lam)
+double
+gammprob (double x, double p, double lam)
/* gamma density */
{
- double xx, yl ;
- xx = MAX(x, 1.0e-8) ;
- yl = (p-1) * log(xx) - lam * xx ;
- yl += p * log(lam) ;
- yl -= xlgamma(p) ;
- return yl ;
+ double xx, yl;
+ xx = MAX(x, 1.0e-8);
+ yl = (p - 1) * log (xx) - lam * xx;
+ yl += p * log (lam);
+ yl -= xlgamma (p);
+ return yl;
}
-
-double lbeta(double a, double b)
+double
+lbeta (double a, double b)
{
- return (xlgamma(a) + xlgamma(b) - xlgamma(a+b) ) ;
+ return (xlgamma (a) + xlgamma (b) - xlgamma (a + b));
}
-
-double dawson(double t)
+double
+dawson (double t)
/**
Dawson's Integral
[A + S 7.31]
exp(-t*t) \int ( exp(x^2), x = 0..t)
loosely based on mcerror.for
-*/
-{
-
- double z1, cs, cr, cl ;
- double z1sq, cer ;
- int k ;
-
- z1 = fabs(t) ;
- if (z1 <= 1.0e-8) return t ;
-/* derivative is 1 at 0 */
- z1sq = -t*t ;
- if (z1 < 4.5) {
- cs = cr = z1 ;
- for (k= 1; k <= 999; ++k) {
- cr *= z1sq/((double) k + 0.5) ;
- cs += cr ;
- if (fabs(cr/cs) < 1.0e-15) break ;
- }
- cer = cs ;
+ */
+{
+
+ double z1, cs, cr, cl;
+ double z1sq, cer;
+ int k;
+
+ z1 = fabs (t);
+ if (z1 <= 1.0e-8)
+ return t;
+ /* derivative is 1 at 0 */
+ z1sq = -t * t;
+ if (z1 < 4.5)
+ {
+ cs = cr = z1;
+ for (k = 1; k <= 999; ++k)
+ {
+ cr *= z1sq / ((double) k + 0.5);
+ cs += cr;
+ if (fabs (cr / cs) < 1.0e-15)
+ break;
}
- else {
- cl = 1/z1 ;
- cr = cl ;
- for (k=1; k<=13; ++k) {
- cr *= -((double) k-0.5) / z1sq ;
- cl += cr ;
- if (fabs(cr/cl) < 1.0e-15) break ;
- }
- cer = 0.5*cl ;
+ cer = cs;
+ }
+ else
+ {
+ cl = 1 / z1;
+ cr = cl;
+ for (k = 1; k <= 13; ++k)
+ {
+ cr *= -((double) k - 0.5) / z1sq;
+ cl += cr;
+ if (fabs (cr / cl) < 1.0e-15)
+ break;
}
- if (t<0) cer = -cer ;
- return cer ;
+ cer = 0.5 * cl;
+ }
+ if (t < 0)
+ cer = -cer;
+ return cer;
}
-double binlogtail(int n, int t, double p, char c)
+double
+binlogtail (int n, int t, double p, char c)
{
- double *bindis ;
- double val, base ;
+ double *bindis;
+ double val, base;
- ZALLOC(bindis, n+1, double) ;
- genlogbin(bindis, n, p) ;
- base = bindis[t] ;
- vsp(bindis, bindis, -base, n+1) ;
- if (c=='+') {
- vexp(bindis+t, bindis+t, n-t+1) ;
- val = asum(bindis+t, n-t+1) ;
+ ZALLOC(bindis, n + 1, double);
+ genlogbin (bindis, n, p);
+ base = bindis[t];
+ vsp (bindis, bindis, -base, n + 1);
+ if (c == '+')
+ {
+ vexp (bindis + t, bindis + t, n - t + 1);
+ val = asum (bindis + t, n - t + 1);
}
- else {
- vexp(bindis, bindis, t) ;
- val = asum(bindis, t) ;
+ else
+ {
+ vexp (bindis, bindis, t);
+ val = asum (bindis, t);
}
- free(bindis) ;
- return (log(val) + base) ;
+ free (bindis);
+ return (log (val) + base);
}
-double binomtail(int n, int t, double p, char c)
+double
+binomtail (int n, int t, double p, char c)
+{
+ /**
+ c = '+': P(S>=t)
+ c = '-': P(S<t)
+ WARNING <= t use binomtail(n, t+1, ...
+ */
+ double *bindis;
+ double val;
+
+ ZALLOC(bindis, n + 1, double);
+ genlogbin (bindis, n, p);
+ vexp (bindis, bindis, n + 1);
+ if (c == '+')
+ val = asum (bindis + t, n - t + 1);
+ else
+ val = asum (bindis, t);
+ free (bindis);
+ return val;
+}
+
+void
+genbin (double *a, int n, double p)
{
-/**
- c = '+': P(S>=t)
- c = '-': P(S<t)
- WARNING <= t use binomtail(n, t+1, ...
-*/
- double *bindis ;
- double val ;
-
- ZALLOC(bindis, n+1, double) ;
- genlogbin(bindis, n, p) ;
- vexp(bindis, bindis, n+1) ;
- if (c=='+')
- val = asum(bindis+t, n-t+1) ;
- else
- val = asum(bindis, t) ;
- free(bindis) ;
- return val ;
-}
-void genbin(double *a, int n, double p)
-{
- vzero(a, n+1) ;
- if (p<=0.0) {
- a[0] = 1.0 ;
- return ;
- }
- if (p>=1.0) {
- a[n] = 1.0 ;
- return ;
- }
-
- genlogbin(a, n, p) ;
- vexp(a, a, n+1) ;
- bal1(a, n+1) ;
+ vzero (a, n + 1);
+ if (p <= 0.0)
+ {
+ a[0] = 1.0;
+ return;
+ }
+ if (p >= 1.0)
+ {
+ a[n] = 1.0;
+ return;
+ }
+
+ genlogbin (a, n, p);
+ vexp (a, a, n + 1);
+ bal1 (a, n + 1);
}
void
-genlogbin(double *a, int n, double p)
+genlogbin (double *a, int n, double p)
/* generate log prob for binomial distribution */
// a must be n+1 long
{
- double q, plog, qlog ;
- double *lfac, x ;
- int i, r, s ;
- q = 1.0-p ;
- plog = log(p), qlog = log(q) ;
+ double q, plog, qlog;
+ double *lfac, x;
+ int i, r, s;
+ q = 1.0 - p;
+ plog = log (p), qlog = log (q);
- ZALLOC(lfac,n+1,double) ;
- for (i=1; i<=n; i++) {
- x = (double) i ;
- lfac[i] = lfac[i-1] + log(x) ;
+ ZALLOC(lfac, n + 1, double);
+ for (i = 1; i <= n; i++)
+ {
+ x = (double) i;
+ lfac[i] = lfac[i - 1] + log (x);
}
- for (r=0; r<=n; r++) {
- s = n-r ;
- x = lfac[n]-lfac[r]-lfac[s] ; /* log binom coeff */
- x += ((double) r) * plog ;
- x += ((double) s) * qlog ;
- a[r] = x ; /* log prob */
+ for (r = 0; r <= n; r++)
+ {
+ s = n - r;
+ x = lfac[n] - lfac[r] - lfac[s]; /* log binom coeff */
+ x += ((double) r) * plog;
+ x += ((double) s) * qlog;
+ a[r] = x; /* log prob */
}
- free(lfac) ;
+ free (lfac);
}
-double xlgamma(double x)
+double
+xlgamma (double x)
// a version of lgamma since the linux version is
// causing trouble ???
-{
- static double l2pi = -1.0 ;
- double term, y, zz ;
- int k, t ;
+{
+ static double l2pi = -1.0;
+ double term, y, zz;
+ int k, t;
- if (x<=0.0) fatalx("xlgamma: x <= 0 %9.3f\n",x) ;
+ if (x <= 0.0)
+ fatalx ("xlgamma: x <= 0 %9.3f\n", x);
// return lgamma(x) ;
- t = (int) sizeof(long) ;
- if (t >= 8) return lgamma(x) ; // 64 bit machines
- if (l2pi < 0.0 ) l2pi = log(4.0*acos(0.0)) ;
- bernload() ;
- if (x<10.0) return (xlgamma(x+1.0) - log(x)) ;
- y = (x-0.5)*log(x) -x + 0.5*l2pi ;
- zz = 1.0/x ;
- for (k=1; k<= bernmax/2 ; k++) {
- t = 2*k ;
- term = bernum(2*k)/(double) (t*(t-1)) ;
- term *= zz ;
- y += term ;
- zz /= (x*x) ;
- }
- if (!finite(y)) fatalx("bad xlgamma\n") ;
- return y ;
-}
-
-double rtlchsq(int df, double z)
-{
- double a, x, y ;
- if (df==1) return 2.0*ntail(sqrt(z)) ;
- if (df==2) return exp(-0.5*z) ;
-
- if (df <= 0.0) return 1.0 ;
- y = pochisq(z, df) ;
- if (y<1.0e-6) {
- a = 0.5*(double) df ;
- x = 0.5*z ;
- return rtlg(a,x) ;
- }
- return y ;
+ t = (int) sizeof(long);
+ if (t >= 8)
+ return lgamma (x); // 64 bit machines
+ if (l2pi < 0.0)
+ l2pi = log (4.0 * acos (0.0));
+ bernload ();
+ if (x < 10.0)
+ return (xlgamma (x + 1.0) - log (x));
+ y = (x - 0.5) * log (x) - x + 0.5 * l2pi;
+ zz = 1.0 / x;
+ for (k = 1; k <= bernmax / 2; k++)
+ {
+ t = 2 * k;
+ term = bernum (2 * k) / (double) (t * (t - 1));
+ term *= zz;
+ y += term;
+ zz /= (x * x);
+ }
+ if (!finite (y))
+ fatalx ("bad xlgamma\n");
+ return y;
+}
+
+double
+rtlchsq (int df, double z)
+{
+ double a, x, y;
+ if (df == 1)
+ return 2.0 * ntail (sqrt (z));
+ if (df == 2)
+ return exp (-0.5 * z);
+
+ if (df <= 0.0)
+ return 1.0;
+ y = pochisq (z, df);
+ if (y < 1.0e-6)
+ {
+ a = 0.5 * (double) df;
+ x = 0.5 * z;
+ return rtlg (a, x);
+ }
+ return y;
}
/*ALGORITHM Compute probability of chi square value.
- Adapted from:
- Hill, I. D. and Pike, M. C. Algorithm 299
- Collected Algorithms for the CACM 1967 p. 243
- Updated for rounding errors based on remark in
- ACM TOMS June 1985, page 185
- Perlman. No copyright
-*/
+ Adapted from:
+ Hill, I. D. and Pike, M. C. Algorithm 299
+ Collected Algorithms for the CACM 1967 p. 243
+ Updated for rounding errors based on remark in
+ ACM TOMS June 1985, page 185
+ Perlman.
+ */
double
pochisq (double x, int df)
{
- double a, y, s;
- double e, c, z;
- double poz (); /* computes probability of normal z score */
- int even; /* true if df is an even number */
-
- if (x <= 0.0 || df < 1)
- return (1.0);
-
- a = 0.5 * x;
- even = (2*(df/2)) == df;
- if (df > 1)
- y = ex (-a);
- s = (even ? y : (2.0 * ntail (sqrt (x))));
- if (df > 2)
- {
- x = 0.5 * (df - 1.0);
- z = (even ? 1.0 : 0.5);
- if (a > BIGX)
- {
- e = (even ? 0.0 : LOG_SQRT_PI);
- c = log (a);
- while (z <= x)
- {
- e = log (z) + e;
- s += ex (c*z-a-e);
- z += 1.0;
- }
- return (s);
- }
- else
- {
- e = (even ? 1.0 : (I_SQRT_PI / sqrt (a)));
- c = 0.0;
- while (z <= x)
- {
- e = e * (a / z);
- c = c + e;
- z += 1.0;
- }
- return (c * y + s);
- }
- }
- else
- return (s);
-}
-
-double critchi (int df, double p)
+ double a, y, s;
+ double e, c, z;
+ double
+ poz (); /* computes probability of normal z score */
+ int even; /* true if df is an even number */
+
+ if (x <= 0.0 || df < 1)
+ return (1.0);
+
+ a = 0.5 * x;
+ even = (2 * (df / 2)) == df;
+ if (df > 1)
+ y = ex(-a);
+ s = (even ? y : (2.0 * ntail (sqrt (x))));
+ if (df > 2)
+ {
+ x = 0.5 * (df - 1.0);
+ z = (even ? 1.0 : 0.5);
+ if (a > BIGX)
+ {
+ e = (even ? 0.0 : LOG_SQRT_PI);
+ c = log (a);
+ while (z <= x)
+ {
+ e = log (z) + e;
+ s += ex(c * z - a - e);
+ z += 1.0;
+ }
+ return (s);
+ }
+ else
+ {
+ e = (even ? 1.0 : (I_SQRT_PI / sqrt (a)));
+ c = 0.0;
+ while (z <= x)
+ {
+ e = e * (a / z);
+ c = c + e;
+ z += 1.0;
+ }
+ return (c * y + s);
+ }
+ }
+ else
+ return (s);
+}
+
+double
+critchi (int df, double p)
/* Perlman. arguments interchanged */
{
- double minchisq = 0.0;
- double maxchisq = 100.0*p;
- double chisqval, z, y ;;
-
- if (p <= 0.0)
- return (maxchisq);
- else if (p >= 1.0)
- return (0.0);
-
- if (df==1) {
- z = zprob(0.5*p) ;
- return z*z ;
- }
+ double minchisq = 0.0;
+ double maxchisq = 100.0 * p;
+ double chisqval, z, y;
+ ;
- if (df==2) {
- y = -log(p) ;
- return 2*y ;
- }
-
- chisqval = df / sqrt (p); /* fair first value */
- while (maxchisq - minchisq > CHI_EPSILON)
- {
- if (rtlchsq (df, chisqval) < p)
- maxchisq = chisqval;
- else
- minchisq = chisqval;
- chisqval = (maxchisq + minchisq) * 0.5;
- }
- return (chisqval);
+ if (p <= 0.0)
+ return (maxchisq);
+ else if (p >= 1.0)
+ return (0.0);
+
+ if (df == 1)
+ {
+ z = zprob (0.5 * p);
+ return z * z;
+ }
+
+ if (df == 2)
+ {
+ y = -log (p);
+ return 2 * y;
+ }
+
+ chisqval = df / sqrt (p); /* fair first value */
+ while (maxchisq - minchisq > CHI_EPSILON)
+ {
+ if (rtlchsq (df, chisqval) < p)
+ maxchisq = chisqval;
+ else
+ minchisq = chisqval;
+ chisqval = (maxchisq + minchisq) * 0.5;
+ }
+ return (chisqval);
}
/*
- Module: f.c
- Purpose: compute approximations to F distribution probabilities
- Contents: pof(), critf()
- Programmer: Gary Perlman
- Organization: Wang Institute, Tyngsboro, MA 01879
- Tester: compile with -DFTEST to include main program
- Copyright: none
- Tabstops: 4
-*/
-
-
-#ifndef I_PI /* 1 / pi */
+ Module: f.c
+ Purpose: compute approximations to F distribution probabilities
+ Contents: pof(), critf()
+ Programmer: Gary Perlman
+ Organization: Wang Institute, Tyngsboro, MA 01879
+ Tester: compile with -DFTEST to include main program
+ Tabstops: 4
+ */
+
+#ifndef I_PI /* 1 / pi */
#define I_PI 0.3183098861837906715377675
#endif
-#define F_EPSILON 0.000001 /* accuracy of critf approximation */
-#define F_MAX 9999.0 /* maximum F ratio */
-
-
-double rtlf(int df1, int df2, double F)
-{
- return pof(F, df1, df2) ;
-}
-
-static
-double pof (double F, int df1, int df2)
-{
- int i, j;
- int a, b;
- double w, y, z, d, p;
-
- if (F < F_EPSILON || df1 < 1 || df2 < 1)
- return (1.0);
- a = df1%2 ? 1 : 2;
- b = df2%2 ? 1 : 2;
- w = (F * df1) / df2;
- z = 1.0 / (1.0 + w);
- if (a == 1)
- if (b == 1)
- {
- p = sqrt (w);
- y = I_PI; /* 1 / 3.14159 */
- d = y * z / p;
- p = 2.0 * y * atan (p);
- }
- else
- {
- p = sqrt (w * z);
- d = 0.5 * p * z / w;
- }
- else if (b == 1)
- {
- p = sqrt (z);
- d = 0.5 * z * p;
- p = 1.0 - p;
- }
- else
- {
- d = z * z;
- p = w * z;
- }
- y = 2.0 * w / z;
-#ifdef REMARK /* speedup modification suggested by Tolman (wrong answer!) */
- if (a == 1)
- for (j = b + 2; j <= df2; j += 2)
- {
- d *= (1.0 + a / (j - 2.0)) * z;
- p += d * y / (j - 1.0);
- }
- else
- {
- double zk = 1.0;
- for (j = (df2 - 1) / 2; j; j--)
- zk *= z;
- d *= zk * df2/b;
- p *= zk + w * z * (zk - 1.0)/(z-1.0);
- }
+#define F_EPSILON 0.000001 /* accuracy of critf approximation */
+#define F_MAX 9999.0 /* maximum F ratio */
+
+double
+rtlf (int df1, int df2, double F)
+{
+ return pof (F, df1, df2);
+}
+
+static double
+pof (double F, int df1, int df2)
+{
+ int i, j;
+ int a, b;
+ double w, y, z, d, p;
+
+ if (F < F_EPSILON || df1 < 1 || df2 < 1)
+ return (1.0);
+ a = df1 % 2 ? 1 : 2;
+ b = df2 % 2 ? 1 : 2;
+ w = (F * df1) / df2;
+ z = 1.0 / (1.0 + w);
+ if (a == 1)
+ if (b == 1)
+ {
+ p = sqrt (w);
+ y = I_PI; /* 1 / 3.14159 */
+ d = y * z / p;
+ p = 2.0 * y * atan (p);
+ }
+ else
+ {
+ p = sqrt (w * z);
+ d = 0.5 * p * z / w;
+ }
+ else if (b == 1)
+ {
+ p = sqrt (z);
+ d = 0.5 * z * p;
+ p = 1.0 - p;
+ }
+ else
+ {
+ d = z * z;
+ p = w * z;
+ }
+ y = 2.0 * w / z;
+#ifdef REMARK /* speedup modification suggested by Tolman (wrong answer!) */
+ if (a == 1)
+ for (j = b + 2; j <= df2; j += 2)
+ {
+ d *= (1.0 + a / (j - 2.0)) * z;
+ p += d * y / (j - 1.0);
+ }
+ else
+ {
+ double zk = 1.0;
+ for (j = (df2 - 1) / 2; j; j--)
+ zk *= z;
+ d *= zk * df2 / b;
+ p *= zk + w * z * (zk - 1.0) / (z - 1.0);
+ }
#else /* original version */
- for (j = b + 2; j <= df2; j += 2)
- {
- d *= (1.0 + a / (j - 2.0)) * z;
- p = (a == 1 ? p + d * y / (j - 1.0) : (p + w) * z);
- }
-#endif
- y = w * z;
- z = 2.0 / z;
- b = df2 - 2;
- for (i = a + 2; i <= df1; i += 2)
- {
- j = i + b;
- d *= y * j / (i - 2.0);
- p -= z * d / j;
- }
- /* correction for approximation errors suggested in certification */
- if (p < 0.0)
- p = 0.0;
- else if (p > 1.0)
- p = 1.0;
- return (1.0-p);
+ for (j = b + 2; j <= df2; j += 2)
+ {
+ d *= (1.0 + a / (j - 2.0)) * z;
+ p = (a == 1 ? p + d * y / (j - 1.0) : (p + w) * z);
+ }
+#endif
+ y = w * z;
+ z = 2.0 / z;
+ b = df2 - 2;
+ for (i = a + 2; i <= df1; i += 2)
+ {
+ j = i + b;
+ d *= y * j / (i - 2.0);
+ p -= z * d / j;
+ }
+ /* correction for approximation errors suggested in certification */
+ if (p < 0.0)
+ p = 0.0;
+ else if (p > 1.0)
+ p = 1.0;
+ return (1.0 - p);
}
// incomplete gamma function. P(z<x) if standard gamma shape a
-double ltlg(double a, double x)
+double
+ltlg (double a, double x)
{
- if (x<=0.0) return 0.0 ;
- if (x <= (1.0+a) ) return ltlg1(a,x) ;
- return ltlg2(a,x) ;
+ if (x <= 0.0)
+ return 0.0;
+ if (x <= (1.0 + a))
+ return ltlg1 (a, x);
+ return ltlg2 (a, x);
}
+
// incomplete gamma function. P(z>x) if standard gamma shape a
-double rtlg(double a, double x)
-{
- if (x<=0.0) return 1.0 ;
- if (x <= (1.0+a) ) return rtlg1(a,x) ;
- return rtlg2(a,x) ;
+double
+rtlg (double a, double x)
+{
+ if (x <= 0.0)
+ return 1.0;
+ if (x <= (1.0 + a))
+ return rtlg1 (a, x);
+ return rtlg2 (a, x);
}
-double ltlg1(double a, double x)
+double
+ltlg1 (double a, double x)
{
- double r, s, tiny = 1.0e-14 ;
- double yk, y1, xam ;
- int k ;
+ double r, s, tiny = 1.0e-14;
+ double yk, y1, xam;
+ int k;
- s = 1.0/a ;
- r= s ;
- for (k=1; k<=60; ++k) {
- yk = (double) k ;
- r *= (x/(a+yk)) ;
- s += r ;
- if (fabs(r/s) < tiny) break ;
+ s = 1.0 / a;
+ r = s;
+ for (k = 1; k <= 60; ++k)
+ {
+ yk = (double) k;
+ r *= (x / (a + yk));
+ s += r;
+ if (fabs (r / s) < tiny)
+ break;
}
- xam = (a*log(x))-x ;
- y1 = xam + log(s) ;
- y1 -= xlgamma(a) ;
- y1 = exp(y1) ;
- if (isnan(y1)) fatalx("bad ltlg1\n") ;
- return y1 ;
+ xam = (a * log (x)) - x;
+ y1 = xam + log (s);
+ y1 -= xlgamma (a);
+ y1 = exp (y1);
+ if (isnan(y1))
+ fatalx ("bad ltlg1\n");
+ return y1;
}
-double ltlg2(double a, double x)
+double
+ltlg2 (double a, double x)
{
- return 1.0 - rtlg2(a, x) ;
+ return 1.0 - rtlg2 (a, x);
}
-
-double rtlg1(double a, double x)
+double
+rtlg1 (double a, double x)
{
- return 1.0 - ltlg1(a, x) ;
+ return 1.0 - ltlg1 (a, x);
}
-double rtlg2(double a, double x)
+double
+rtlg2 (double a, double x)
{
- double y1, y2 ;
- double yk, top, bot, t0, xam ;
- int k ;
- t0 = 0.0 ;
+ double y1, y2;
+ double yk, top, bot, t0, xam;
+ int k;
+ t0 = 0.0;
// ZJ p 64 ff
- for (k=60; k>=1; --k) {
- yk = (double) k ;
- top = yk - a ;
- bot = yk / (x+t0) ;
- ++bot ;
- t0 = top/bot ;
- }
- xam = (a*log(x))-x ;
- y1 = xam - log(x+t0) ;
- y1 -= xlgamma(a) ;
- y1 = exp(y1) ;
- if (isnan(y1)) fatalx("bad rtlg2\n") ;
- return y1 ;
+ for (k = 60; k >= 1; --k)
+ {
+ yk = (double) k;
+ top = yk - a;
+ bot = yk / (x + t0);
+ ++bot;
+ t0 = top / bot;
+ }
+ xam = (a * log (x)) - x;
+ y1 = xam - log (x + t0);
+ y1 -= xlgamma (a);
+ y1 = exp (y1);
+ if (isnan(y1))
+ fatalx ("bad rtlg2\n");
+ return y1;
}
-void cinterp(double val, double x0, double x1,
- double f0, double f0p, double f1, double f1p, double *fv, double *fvp) ;
-int firstgtx(double val, double *tab, int n) ;
-static int gtx(double *tab, int lo, int hi, double val) ;
-void gettw(double x, double *tailp, double *densp) ;
+void
+cinterp (double val, double x0, double x1, double f0, double f0p, double f1,
+ double f1p, double *fv, double *fvp);
+int
+firstgtx (double val, double *tab, int n);
+static int
+gtx (double *tab, int lo, int hi, double val);
+void
+gettw (double x, double *tailp, double *densp);
-double twdens(double twstat)
+double
+twdens (double twstat)
// Tracy-Widom prob density
{
- double dens, tail ;
+ double dens, tail;
- gettw(twstat, &dens, &tail) ;
- return dens ;
+ gettw (twstat, &dens, &tail);
+ return dens;
}
-double twtail(double twstat)
+double
+twtail (double twstat)
// Tracy-Widom right tail
{
- double dens, tail ;
- static int ncall = 0 ;
-
+ double dens, tail;
+ static int ncall = 0;
- ++ncall ;
+ ++ncall;
- gettw(twstat, &tail, &dens) ;
-/**
- printf("zz %9.3f %9.3f\n", twstat, tail) ;
- if (ncall==10) abort() ;
-*/
- return tail ;
+ gettw (twstat, &tail, &dens);
+ /**
+ printf("zz %9.3f %9.3f\n", twstat, tail) ;
+ if (ncall==10) abort() ;
+ */
+ return tail;
}
-double twdensx(double tw)
+double
+twdensx (double tw)
// Margetis-Edelman
{
- double bot, lbot, ltop, y1, y2 ;
+ double bot, lbot, ltop, y1, y2;
- if (tw<=0.0) return 0.0 ;
- bot = (SQRT_PI) * 4.0 ;
- lbot = log(bot) ;
- y1 = -0.25*log(tw) ;
- y2 = -2.0*pow(tw, 1.5)/3.0 ;
- ltop = y1 + y2 ;
- return exp(ltop-lbot) ;
+ if (tw <= 0.0)
+ return 0.0;
+ bot = (SQRT_PI) * 4.0;
+ lbot = log (bot);
+ y1 = -0.25 * log (tw);
+ y2 = -2.0 * pow (tw, 1.5) / 3.0;
+ ltop = y1 + y2;
+ return exp (ltop - lbot);
}
-double twtailx(double tw)
+double
+twtailx (double tw)
// right tail Margetis-Edelman
{
- double bot, lbot, ltop, y1, y2 ;
+ double bot, lbot, ltop, y1, y2;
- if (tw<=0.0) return 1.0 ;
- bot = (SQRT_PI) * 4.0 ;
- lbot = log(bot) ;
- y1 = -0.75*log(tw) ;
- y2 = -2.0*pow(tw, 1.5)/3.0 ;
- ltop = y1 + y2 ;
- return exp(ltop-lbot) ;
+ if (tw <= 0.0)
+ return 1.0;
+ bot = (SQRT_PI) * 4.0;
+ lbot = log (bot);
+ y1 = -0.75 * log (tw);
+ y2 = -2.0 * pow (tw, 1.5) / 3.0;
+ ltop = y1 + y2;
+ return exp (ltop - lbot);
}
-void twfree()
+void
+twfree ()
// destructor. Here for completeness
{
- if (twtabsize<0) return ;
- free(twxval) ;
- free(twxpdf) ;
- free(twxtail) ;
- twtabsize = -1;
-
-
+ if (twtabsize < 0)
+ return;
+ free (twxval);
+ free (twxpdf);
+ free (twxtail);
+ twtabsize = -1;
}
-
-double twnorm(double lam, double p, double n)
+double
+twnorm (double lam, double p, double n)
// Ref Johnstone (2001)
-{
- double mu, phi , y1, y2 ;
+{
+ double mu, phi, y1, y2;
- if (n<0.0) return -10.0 ;
- if (p<0.0) return -10.0 ;
+ if (n < 0.0)
+ return -10.0;
+ if (p < 0.0)
+ return -10.0;
- if (n<p) return twnorm(lam, n, p) ;
+ if (n < p)
+ return twnorm (lam, n, p);
// not very important refinement as twnorm symmetric in p, n-1 NJP
- y1 = sqrt(n-1) + sqrt(p) ;
- mu = y1*y1 ;
- y2 = (1.0/sqrt(n-1)) + 1.0/sqrt(p) ;
- phi = y1*pow(y2,1.0/3.0) ;
- return (lam-mu)/phi ;
+ y1 = sqrt (n - 1) + sqrt (p);
+ mu = y1 * y1;
+ y2 = (1.0 / sqrt (n - 1)) + 1.0 / sqrt (p);
+ phi = y1 * pow (y2, 1.0 / 3.0);
+ return (lam - mu) / phi;
}
double
-dotwcalc(double *lambda, int m, double *ptw, double *pzn, double *pzvar, int minm)
-{
- double nv, mv, tzn, tm ;
- double *evals ;
- double y, top, bot, zn, tw, ystat ;
- double tail, lsum ;
-
- if (m<minm) {
- *pzn = *pzvar = *ptw = -1 ;
- return -1.0 ;
- }
- lsum = asum(lambda, m) ;
- if (lsum<=0.0) {
- *pzn = *pzvar = *ptw = -1 ;
- return -1.0 ;
- }
-
- tzn = *pzn ;
- tm = (double) m ;
-
- y = (double) m / lsum ;
- ystat = lambda[0] * y * tzn ;
-
- if (tzn>0.0) {
- tw = twnorm(ystat, tm, tzn) ;
- *pzn = tzn ;
- *ptw = tw ;
- tail = twtail(tw) ;
- return tail ;
- }
- ZALLOC(evals, m, double) ;
- vst(evals, lambda, y, m) ;
- top = (double) (m*(m+2)) ;
- bot = asum2(evals, m) - (double) m ;
- zn = top/bot ; // see appendix to eigenpaper NJP
- y = evals[0]*zn ;
- tw = twnorm(y, tm, zn) ;
- *pzn = zn ;
- *ptw = tw ;
- tail = twtail(tw) ;
- free(evals) ;
- return tail ;
-}
-int numgtz(double *a, int n)
-{
-#define THRESH .000001
-
- int num, k ;
-
- num = 0 ;
- for (k = 0; k < n; ++k) {
- if (a[k]>THRESH) ++num ;
- }
- return num ;
-}
-
-
-static int fgtx(double *tab, int lo, int hi, double val)
-{
-
- int k ;
-
- if (val >= tab[hi]) return hi+1 ;
- if (val < tab[lo]) return lo ;
- k = (lo+hi)/2 ;
- if (val <= tab[k]) return fgtx(tab, lo+1, k, val) ;
- return fgtx(tab, k, hi-1, val) ;
-}
-
-int firstgtx(double val, double *tab, int n)
+dotwcalc (double *lambda, int m, double *ptw, double *pzn, double *pzvar,
+ int minm)
+{
+ double nv, mv, tzn, tm;
+ double *evals;
+ double y, top, bot, zn, tw, ystat;
+ double tail, lsum;
+
+ if (m < minm)
+ {
+ *pzn = *pzvar = *ptw = -1;
+ return -1.0;
+ }
+ lsum = asum (lambda, m);
+ if (lsum <= 0.0)
+ {
+ *pzn = *pzvar = *ptw = -1;
+ return -1.0;
+ }
+
+ tzn = *pzn;
+ tm = (double) m;
+
+ y = (double) m / lsum;
+ ystat = lambda[0] * y * tzn;
+
+ if (tzn > 0.0)
+ {
+ tw = twnorm (ystat, tm, tzn);
+ *pzn = tzn;
+ *ptw = tw;
+ tail = twtail (tw);
+ return tail;
+ }
+ ZALLOC(evals, m, double);
+ vst (evals, lambda, y, m);
+ top = (double) (m * (m + 2));
+ bot = asum2 (evals, m) - (double) m;
+ zn = top / bot; // see appendix to eigenpaper NJP
+ y = evals[0] * zn;
+ tw = twnorm (y, tm, zn);
+ *pzn = zn;
+ *ptw = tw;
+ tail = twtail (tw);
+ free (evals);
+ return tail;
+}
+
+int
+numgtz (double *a, int n)
+{
+#define THRESH .000001
+
+ int num, k;
+
+ num = 0;
+ for (k = 0; k < n; ++k)
+ {
+ if (a[k] > THRESH)
+ ++num;
+ }
+ return num;
+}
+
+static int
+fgtx (double *tab, int lo, int hi, double val)
+{
+
+ int k;
+
+ if (val >= tab[hi])
+ return hi + 1;
+ if (val < tab[lo])
+ return lo;
+ k = (lo + hi) / 2;
+ if (val <= tab[k])
+ return fgtx (tab, lo + 1, k, val);
+ return fgtx (tab, k, hi - 1, val);
+}
+
+int
+firstgtx (double val, double *tab, int n)
// tab sorted in ascending order
{
- return fgtx(tab, 0, n-1, val) ;
+ return fgtx (tab, 0, n - 1, val);
}
-static int jfgtx(int *tab, int lo, int hi, int val)
+static int
+jfgtx (int *tab, int lo, int hi, int val)
{
- int k ;
-
- if (val >= tab[hi]) return hi+1 ;
- if (val < tab[lo]) return lo ;
- k = (lo+hi)/2 ;
- if (val <= tab[k]) return jfgtx(tab, lo+1, k, val) ;
- return jfgtx(tab, k, hi-1, val) ;
+ int k;
+
+ if (val >= tab[hi])
+ return hi + 1;
+ if (val < tab[lo])
+ return lo;
+ k = (lo + hi) / 2;
+ if (val <= tab[k])
+ return jfgtx (tab, lo + 1, k, val);
+ return jfgtx (tab, k, hi - 1, val);
}
-int jfirstgtx(int val, int *tab, int n)
+int
+jfirstgtx (int val, int *tab, int n)
// tab sorted in ascending order
// return first index with tab[x] >= val
{
- return jfgtx(tab, 0, n-1, val) ;
+ return jfgtx (tab, 0, n - 1, val);
}
-int settwxtable(char *table)
+int
+settwxtable (char *table)
{
- FILE *fff ;
- if (twxtable != NULL) return 1 ;
- if (table==NULL)
- twxtable = strdup(TWXTABLE) ;
- else
- twxtable = strdup(table) ;
- fff = fopen(twxtable, "r") ;
- if (fff==NULL) return -1 ;
- fclose(fff) ;
- return 1 ;
+ FILE *fff;
+ if (twxtable != NULL)
+ return 1;
+ if (table == NULL)
+// twxtable = strdup (TWXTABLE);
+ return 1;
+ else
+ twxtable = strdup (table);
+ fff = fopen (twxtable, "r");
+ if (fff == NULL)
+ return -1;
+ fclose (fff);
+ return 1;
}
void
-gettw(double x, double *tailp, double *densp)
+gettw (double x, double *tailp, double *densp)
// main routine for accessing twtable
-
{
- int k, n ;
- double x0, x1, f0, f1, f0p, f1p ;
- double *xx[3] ;
-
-
- if (twtabsize == -1) {
-
- if (settwxtable(TWXTABLE) < 0)
- fatalx("twtable not readable %s\n", TWXTABLE) ;
- k = numlines(twxtable) ;
- ZALLOC(twxval, k, double) ;
- ZALLOC(twxpdf, k, double) ;
- ZALLOC(twxtail, k, double) ;
- xx[0] = twxval ;
- xx[1] = twxtail ;
- xx[2] = twxpdf ;
- twtabsize = getxx(xx, k, 3, twxtable) ;
- }
- n = twtabsize ;
-
- k = firstgtx(x, twxval, n) ;
-
- if (k<=0) {
- *tailp = 1.0 ;
- *densp = 0.0 ;
- return ;
- }
-
- if (k>=n) {
- *tailp = twdensx(x) ;
- *densp = twtailx(x) ;
- return ;
- }
-
- x0 = twxval[k-1] ;
- x1 = twxval[k] ;
- f0 = twxtail[k-1] ;
- f0p = twxpdf[k-1] ;
- f1 = twxtail[k] ;
- f1p = twxpdf[k] ;
+ int k, n;
+ double x0, x1, f0, f1, f0p, f1p;
+ double *xx[3];
+
+ if (twtabsize == -1)
+ {
+ twtabsize = TWTABSIZE;
+ ZALLOC(twxval, twtabsize, double);
+ ZALLOC(twxpdf, twtabsize, double);
+ ZALLOC(twxtail, twtabsize, double);
+ memcpy (twxval, TWXVAL, twtabsize * sizeof(double));
+ memcpy (twxpdf, TWXPDF, twtabsize * sizeof(double));
+ memcpy (twxtail, TWXTAIL, twtabsize * sizeof(double));
+ }
+ n = twtabsize;
+
+ k = firstgtx (x, twxval, n);
+
+ if (k <= 0)
+ {
+ *tailp = 1.0;
+ *densp = 0.0;
+ return;
+ }
+
+ if (k >= n)
+ {
+ *tailp = twdensx (x);
+ *densp = twtailx (x);
+ return;
+ }
+
+ x0 = twxval[k - 1];
+ x1 = twxval[k];
+ f0 = twxtail[k - 1];
+ f0p = twxpdf[k - 1];
+ f1 = twxtail[k];
+ f1p = twxpdf[k];
// now do cubic interpolation
- cinterp(x, x0, x1,
- f0, -f0p, f1, -f1p, tailp, densp) ;
- *densp = - *densp ;
+ cinterp (x, x0, x1, f0, -f0p, f1, -f1p, tailp, densp);
+ *densp = -*densp;
-/**
- printf("zzz %9.3f %9.3f %9.3f\n", x0, x1, x) ;
- printf("zz1 %9.3f %9.3f %9.3f\n", f0, f1, *tailp) ;
- printf("zz2 %9.3f %9.3f %9.3f\n", f0p, f1p, *densp) ;
-*/
+ /**
+ printf("zzz %9.3f %9.3f %9.3f\n", x0, x1, x) ;
+ printf("zz1 %9.3f %9.3f %9.3f\n", f0, f1, *tailp) ;
+ printf("zz2 %9.3f %9.3f %9.3f\n", f0p, f1p, *densp) ;
+ */
}
-void cinterp(double val, double x0, double x1,
- double f0, double f0p, double f1, double f1p, double *fv, double *fvp)
+void
+cinterp (double val, double x0, double x1, double f0, double f0p, double f1,
+ double f1p, double *fv, double *fvp)
// cubic interpolation val should be between x0 and x1
// fv is function at x
// fvp is derivative
-
{
- double inc, yval, f, fp, a0, b0, a1, b1, a2, a3 ;
- double c0, c1, cc0, cc1 ;
+ double inc, yval, f, fp, a0, b0, a1, b1, a2, a3;
+ double c0, c1, cc0, cc1;
+
+ inc = x1 - x0;
+ yval = (val - x0) / inc;
+ b0 = f0;
+ b1 = f0p * inc;
+ c0 = f1;
+ c1 = f1p * inc;
- inc = x1-x0 ;
- yval = (val-x0)/inc ;
- b0 = f0 ;
- b1 = f0p*inc ;
- c0 = f1 ;
- c1 = f1p*inc ;
-
- a0 = b0 ;
- a1 = b1 ;
- cc0 = c0 - (a0+a1) ;
- cc1 = c1 - a1 ;
- a2 = 3*cc0-cc1 ;
- a3 = cc1 - 2*cc0 ;
+ a0 = b0;
+ a1 = b1;
+ cc0 = c0 - (a0 + a1);
+ cc1 = c1 - a1;
+ a2 = 3 * cc0 - cc1;
+ a3 = cc1 - 2 * cc0;
- f = a3 ;
- f *= yval ;
- f += a2 ;
- f *= yval ;
- f += a1 ;
- f *= yval ;
- f += a0 ;
- *fv = f ;
- fp = 3*a3 ;
- fp *= yval ;
- fp += 2*a2 ;
- fp *= yval ;
- fp += a1 ;
+ f = a3;
+ f *= yval;
+ f += a2;
+ f *= yval;
+ f += a1;
+ f *= yval;
+ f += a0;
+ *fv = f;
+ fp = 3 * a3;
+ fp *= yval;
+ fp += 2 * a2;
+ fp *= yval;
+ fp += a1;
- *fv = f ;
- *fvp = fp/inc ;
+ *fv = f;
+ *fvp = fp / inc;
}
-double dirmult(double *pp, int *aa, int len)
+double
+dirmult (double *pp, int *aa, int len)
{
- int t, i, m ;
- double y1, y2, ysum ;
- double top, bot ;
-
- m = len ;
+ int t, i, m;
+ double y1, y2, ysum;
+ double top, bot;
- t = intsum(aa,m) ;
- if (t < 1) return 0.0 ;
+ m = len;
- top = bot = 0.0 ;
- ysum = asum(pp,m) ;
- for (i=0; i<m; i++) {
- top += lgamma(pp[i] + (double) aa[i]) ;
- bot += lgamma(pp[i]) ;
- }
- top += lgamma(ysum) ;
- bot += lgamma(ysum + (double) t) ;
+ t = intsum (aa, m);
+ if (t < 1)
+ return 0.0;
+ top = bot = 0.0;
+ ysum = asum (pp, m);
+ for (i = 0; i < m; i++)
+ {
+ top += lgamma (pp[i] + (double) aa[i]);
+ bot += lgamma (pp[i]);
+ }
+ top += lgamma (ysum);
+ bot += lgamma (ysum + (double) t);
- y1 = top-bot ;
+ y1 = top - bot;
- return y1 -y2 ;
+ return y1 - y2;
}
-
-double betaix(double a, double b, double lo, double hi)
+double
+betaix (double a, double b, double lo, double hi)
{
- double y1, y2 ;
+ double y1, y2;
- y1 = betai(a,b, lo) ;
- y2 = betai(a,b, hi) ;
+ y1 = betai (a, b, lo);
+ y2 = betai (a, b, hi);
- if (!finite(y1)) fatalx("bad y1\n") ;
- if (!finite(y2)) fatalx("bad y2\n") ;
+ if (!finite (y1))
+ fatalx ("bad y1\n");
+ if (!finite (y2))
+ fatalx ("bad y2\n");
- return y2-y1 ;
+ return y2 - y1;
}
-double betai(double a, double b, double x)
-{
- double betacf(double a, double b, double x);
- double bt;
- if (x < 0.0 || x > 1.0) fatalx( "Bad x in routine betai\n");
- if (x==0.0) return 0.0 ;
- if (x==1.0) return 1.0 ;
- /* Factors in front of the continued fraction. */
- bt=exp(lgamma(a+b)-lgamma(a)-lgamma(b)+a*log(x)+b*log(1.0-x));
- if (x < (a+1.0)/(a+b+2.0)) /* Use continued fraction directly. */
- return bt*betacf(a,b,x)/a;
- else /* Use continued faction after making */
- return 1.0-bt*betacf(b,a,1.0-x)/b; /* the symmetry transformation. */
+double
+betai (double a, double b, double x)
+{
+ double
+ betacf (double a, double b, double x);
+ double bt;
+
+ if (x < 0.0 || x > 1.0)
+ fatalx ("Bad x in routine betai\n");
+ if (x == 0.0)
+ return 0.0;
+ if (x == 1.0)
+ return 1.0;
+ /* Factors in front of the continued fraction. */
+ bt = exp (
+ lgamma (a + b) - lgamma (a) - lgamma (b) + a * log (x)
+ + b * log (1.0 - x));
+ if (x < (a + 1.0) / (a + b + 2.0)) /* Use continued fraction directly. */
+ return bt * betacf (a, b, x) / a;
+ else
+ /* Use continued faction after making */
+ return 1.0 - bt * betacf (b, a, 1.0 - x) / b; /* the symmetry transformation. */
}
+
/*********************************************************************
- Continued fraction evaluation routine needed for the incomplete beta
- function, I_x(a,b).
- C.A. Bertulani May/16/2000
-*********************************************************************/
+ Continued fraction evaluation routine needed for the incomplete beta
+ function, I_x(a,b).
+ C.A. Bertulani May/16/2000
+ *********************************************************************/
-static double betacf(double a, double b, double x)
+static double
+betacf (double a, double b, double x)
/* Used by betai: Evaluates continued fraction for incomplete beta function
- by modified Lentz's method. */
+ by modified Lentz's method. */
{
#define MAXIT 100
#define EPS 3.0e-7
#define FPMIN 1.0e-30
- int m,m2;
- double aa,c,d,del,h,qab,qam,qap;
-
- qab=a+b;
- qap=a+1.0;
- qam=a-1.0;
- c=1.0; /* First step of Lentz's method. */
- d=1.0-qab*x/qap;
- if (fabs(d) < FPMIN) d=FPMIN;
- d=1.0/d;
- h=d;
- for (m=1;m<=MAXIT;m++) {
- m2=2*m;
- aa=m*(b-m)*x/((qam+m2)*(a+m2));
- d=1.0+aa*d; /* One step (the even one) of the recurrence. */
- if (fabs(d) < FPMIN) d=FPMIN;
- c=1.0+aa/c;
- if (fabs(c) < FPMIN) c=FPMIN;
- d=1.0/d;
- h *= d*c;
- aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2));
- d=1.0+aa*d; /* Next step of the recurence the odd one) */
- if (fabs(d) < FPMIN) d=FPMIN;
- c=1.0+aa/c;
- if (fabs(c) < FPMIN) c=FPMIN;
- d=1.0/d;
- del=d*c;
- h *= del;
- if (fabs(del-1.0) < EPS) break; /* Are we done? */
- }
- if (m > MAXIT) fatalx( "a or b too big, or MAXIT too small in betacf\n");
- return h;
-}
-void bpars(double *a, double *b, double mean, double var)
-{
-
- double x2, g, xmean, x, m, v ;
- double xa, xb, ym, yv ;
-
- m = mean; v = var ;
- x = (m*(1-m)-v)/v ;
- xa = x*m ;
- xb = x*(1-m) ;
-
-
-/**
- ym = xa/(xa+xb) ;
- yv = xa*xb/((xa+xb)*(xa+xb)*(xa+xb+1)) ;
- printf("%9.3f %9.3f\n", mean, ym) ;
- printf("%9.3f %9.3f\n", var, yv) ;
-*/
-
- *a = xa ; *b = xb ;
-
-}
-void bmoments(double a, double b, double *mean, double *var)
-{
-
- double x2, g, xmean, x, m, v ;
- double xa, xb, ym, yv ;
-
- x = a+b ;
- *mean = a/x ;
- *var = (a*b)/(x*x*(x+1)) ;
-
-}
-double unbiasedest(int *ndx, int ndsize, int **counts)
-{
-/**
- ndx is ndsize array containing small integers coding pop index of each bracket (pop0 assumed)
- thus ndsize = 4 ndx = (1,1,1,1) codes (p_0-p_1)^4
- thus ndsize = 4 ndx = (1,1,2,3) codes (p_0-p_1)^2 (p_0-p_2) (p_0-p_3)
-
- counts [][] is integer array containing counts[k][0] is count for variant allele for pop k
- counts[k][1] is count for reference allele for pop k
-
-*/
- double xtop, xbot, yest, y ;
- int popind[20] ;
- int popmax, j, k, n, nmax, a, t, s ;
- int *tcounts ;
- double **xmomest, yp ;
-
- ivmaxmin(ndx, ndsize, &popmax, NULL) ;
- //printf("popmax: %d\n", popmax) ;
- ZALLOC(tcounts, popmax+1, int) ;
-
- for (j=0; j <= popmax; ++j) {
- tcounts[j] = counts[j][0] + counts[j][1] ;
- }
-
-/** unbiased estimate of p_j^k */
- xmomest = initarray_2Ddouble(popmax+1, ndsize, 0.0) ;
- for (j=0; j<= popmax; ++j) {
- xmomest[j][0] = 1.0 ;
- for (k=1; k<=ndsize; ++k) {
- xtop = ifall(counts[j][0], k) ;
- xbot = ifall(tcounts[j], k) ;
- if (xbot <= 0.1) xmomest[j][k] = -10000.0 ;
- else xmomest[j][k] = (double) xtop / (double) xbot ;
- //printf("zz %3d %3d %9.3f\n", j, k, xmomest[j][k] ) ;
- }
- }
- nmax = (1<<(ndsize)) -1 ;
- yest = 0.0 ;
-//printf("nmax: %d\n", nmax) ;
+ int m, m2;
+ double aa, c, d, del, h, qab, qam, qap;
+
+ qab = a + b;
+ qap = a + 1.0;
+ qam = a - 1.0;
+ c = 1.0; /* First step of Lentz's method. */
+ d = 1.0 - qab * x / qap;
+ if (fabs (d) < FPMIN)
+ d = FPMIN;
+ d = 1.0 / d;
+ h = d;
+ for (m = 1; m <= MAXIT; m++)
+ {
+ m2 = 2 * m;
+ aa = m * (b - m) * x / ((qam + m2) * (a + m2));
+ d = 1.0 + aa * d; /* One step (the even one) of the recurrence. */
+ if (fabs (d) < FPMIN)
+ d = FPMIN;
+ c = 1.0 + aa / c;
+ if (fabs (c) < FPMIN)
+ c = FPMIN;
+ d = 1.0 / d;
+ h *= d * c;
+ aa = -(a + m) * (qab + m) * x / ((a + m2) * (qap + m2));
+ d = 1.0 + aa * d; /* Next step of the recurence the odd one) */
+ if (fabs (d) < FPMIN)
+ d = FPMIN;
+ c = 1.0 + aa / c;
+ if (fabs (c) < FPMIN)
+ c = FPMIN;
+ d = 1.0 / d;
+ del = d * c;
+ h *= del;
+ if (fabs (del - 1.0) < EPS)
+ break; /* Are we done? */
+ }
+ if (m > MAXIT)
+ fatalx ("a or b too big, or MAXIT too small in betacf\n");
+ return h;
+}
- for (n=0; n<= nmax; ++n) {
- t = n ;
- ivzero(popind, popmax+1) ;
- for (k=0; k<ndsize; ++k) {
- a = 0 ;
- s = t & 1 ;
- t = t >> 1 ;
- if (s==1) a = ndx[k] ;
- ++popind[a] ;
- }
- yp = 1.0 ;
- for (j=0; j<=popmax; ++j) {
- t = popind[j] ;
- s = 0 ; if (j>0) s = t % 2 ; // flags sign
- y = xmomest[j][t] ;
+void
+bpars (double *a, double *b, double mean, double var)
+{
- if (y < -1.0) {
- free(tcounts) ;
- free2D(&xmomest, popmax+1) ;
- return (-10000.0) ;
- }
+ double x2, g, xmean, x, m, v;
+ double xa, xb, ym, yv;
- if (s==1) y = -y ;
- yp *= y ;
- }
- //printf(" %12.6f ", yp) ;
- //printimat(popind, 1, popmax+1) ;
- yest += yp ;
- }
+ m = mean;
+ v = var;
+ x = (m * (1 - m) - v) / v;
+ xa = x * m;
+ xb = x * (1 - m);
+ /**
+ ym = xa/(xa+xb) ;
+ yv = xa*xb/((xa+xb)*(xa+xb)*(xa+xb+1)) ;
+ printf("%9.3f %9.3f\n", mean, ym) ;
+ printf("%9.3f %9.3f\n", var, yv) ;
+ */
+
+ *a = xa;
+ *b = xb;
+
+}
- if (fabs(yest) >= 100) yest = -10000 ;
+void
+bmoments (double a, double b, double *mean, double *var)
+{
+ double x2, g, xmean, x, m, v;
+ double xa, xb, ym, yv;
- free(tcounts) ;
- free2D(&xmomest, popmax+1) ;
- return (yest) ;
+ x = a + b;
+ *mean = a / x;
+ *var = (a * b) / (x * x * (x + 1));
}
-void weightjack(double *est, double *sig, double mean, double *jmean, double *jwt, int g)
+double
+unbiasedest (int *ndx, int ndsize, int **counts)
+{
+ /**
+ ndx is ndsize array containing small integers coding pop index of each bracket (pop0 assumed)
+ thus ndsize = 4 ndx = (1,1,1,1) codes (p_0-p_1)^4
+ thus ndsize = 4 ndx = (1,1,2,3) codes (p_0-p_1)^2 (p_0-p_2) (p_0-p_3)
+
+ counts [][] is integer array containing counts[k][0] is count for variant allele for pop k
+ counts[k][1] is count for reference allele for pop k
+
+ */
+ double xtop, xbot, yest, y;
+ int popind[20];
+ int popmax, j, k, n, nmax, a, t, s;
+ int *tcounts;
+ double **xmomest, yp;
+
+ ivmaxmin (ndx, ndsize, &popmax, NULL);
+ //printf("popmax: %d\n", popmax) ;
+ ZALLOC(tcounts, popmax + 1, int);
+
+ for (j = 0; j <= popmax; ++j)
+ {
+ tcounts[j] = counts[j][0] + counts[j][1];
+ }
+
+ /** unbiased estimate of p_j^k */
+ xmomest = initarray_2Ddouble (popmax + 1, ndsize, 0.0);
+ for (j = 0; j <= popmax; ++j)
+ {
+ xmomest[j][0] = 1.0;
+ for (k = 1; k <= ndsize; ++k)
+ {
+ xtop = ifall (counts[j][0], k);
+ xbot = ifall (tcounts[j], k);
+ if (xbot <= 0.1)
+ xmomest[j][k] = -10000.0;
+ else
+ xmomest[j][k] = (double) xtop / (double) xbot;
+ //printf("zz %3d %3d %9.3f\n", j, k, xmomest[j][k] ) ;
+ }
+ }
+ nmax = (1 << (ndsize)) - 1;
+ yest = 0.0;
+//printf("nmax: %d\n", nmax) ;
+
+ for (n = 0; n <= nmax; ++n)
+ {
+ t = n;
+ ivzero (popind, popmax + 1);
+ for (k = 0; k < ndsize; ++k)
+ {
+ a = 0;
+ s = t & 1;
+ t = t >> 1;
+ if (s == 1)
+ a = ndx[k];
+ ++popind[a];
+ }
+ yp = 1.0;
+ for (j = 0; j <= popmax; ++j)
+ {
+ t = popind[j];
+ s = 0;
+ if (j > 0)
+ s = t % 2; // flags sign
+ y = xmomest[j][t];
+
+ if (y < -1.0)
+ {
+ free (tcounts);
+ free2D (&xmomest, popmax + 1);
+ return (-10000.0);
+ }
+
+ if (s == 1)
+ y = -y;
+ yp *= y;
+ }
+ //printf(" %12.6f ", yp) ;
+ //printimat(popind, 1, popmax+1) ;
+ yest += yp;
+ }
+
+ if (fabs (yest) >= 100)
+ yest = -10000;
+
+ free (tcounts);
+ free2D (&xmomest, popmax + 1);
+ return (yest);
+
+}
+
+void
+weightjack (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g)
// test for jwt 0
{
- double *jjmean, *jjwt ;
- int i, n ;
+ double *jjmean, *jjwt;
+ int i, n;
- ZALLOC(jjmean, g, double) ;
- ZALLOC(jjwt, g, double) ;
- n = 0 ;
+ ZALLOC(jjmean, g, double);
+ ZALLOC(jjwt, g, double);
+ n = 0;
- for (i=0; i<g ; ++i) {
- if (jwt[i] < 1.0e-6) continue ;
- jjmean[n] = jmean[i] ;
- jjwt[n] = jwt[i] ;
- ++n ;
- }
+ for (i = 0; i < g; ++i)
+ {
+ if (jwt[i] < 1.0e-6)
+ continue;
+ jjmean[n] = jmean[i];
+ jjwt[n] = jwt[i];
+ ++n;
+ }
- weightjackx(est, sig, mean, jjmean, jjwt, n) ;
- free(jjmean) ;
- free(jjwt) ;
+ weightjackx (est, sig, mean, jjmean, jjwt, n);
+ free (jjmean);
+ free (jjwt);
}
-static void weightjackx(double *est, double *sig, double mean, double *jmean, double *jwt, int g)
+static void
+weightjackx (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g)
// weighted jackknife see wjack.tex
// mean is natural estimate. jmean[k] mean with block k removed. jwt is weight for block (sample size)
{
- double *tdiff, *hh, *xtau, *w1, *w2 ;
- double jackest, yn, yvar ;
- int k ;
+ double *tdiff, *hh, *xtau, *w1, *w2;
+ double jackest, yn, yvar;
+ int k;
+
+ if (g <= 1)
+ fatalx ("(weightjack) number of blocks <= 1\n");
+ ZALLOC(tdiff, g, double);
+ ZALLOC(hh, g, double);
+ ZALLOC(xtau, g, double);
+ ZALLOC(w1, g, double);
+ ZALLOC(w2, g, double);
- if (g<=1) fatalx("(weightjack) number of blocks <= 1\n") ;
- ZALLOC(tdiff, g, double) ;
- ZALLOC(hh, g, double) ;
- ZALLOC(xtau, g, double) ;
- ZALLOC(w1, g, double) ;
- ZALLOC(w2, g, double) ;
+ yn = asum (jwt, g);
- yn = asum(jwt, g) ;
-
- vsp(tdiff, jmean, -mean, g) ;
- vst(tdiff, tdiff, -1.0, g) ;
- jackest = asum(tdiff, g) + vdot(jwt, jmean, g)/yn ;
+ vsp (tdiff, jmean, -mean, g);
+ vst (tdiff, tdiff, -1.0, g);
+ jackest = asum (tdiff, g) + vdot (jwt, jmean, g) / yn;
// this is equation 2
- vclear(hh, yn, g) ;
- vvd(hh, hh, jwt, g) ;
-/**
- for (k=0; k<g; ++k) {
+ vclear (hh, yn, g);
+ vvd (hh, hh, jwt, g);
+ /**
+ for (k=0; k<g; ++k) {
if (jwt[k] > 0.0) hh[k] /= jwt[k] ;
else hh[k] *= 1.0e20 ;
- }
-*/
+ }
+ */
// jwt should be positive
-
- vst(xtau, hh, mean, g) ;
- vsp(w1, hh, -1.0, g) ;
- vvt(w2, w1, jmean, g) ;
- vvm(xtau, xtau, w2, g) ;
-
- vsp(xtau, xtau, -jackest, g) ;
- vvt (xtau, xtau, xtau, g) ;
- vvd (xtau, xtau, w1, g) ;
- yvar = asum(xtau, g) / (double) g ;
- *est = jackest ;
- *sig = 0.0 ;
- if (yvar > 0) *sig = sqrt(yvar) ;
-
- free(tdiff) ;
- free(hh) ;
- free(xtau) ;
- free(w1) ;
- free(w2) ;
-
-}
-int modehprob(int n, int a, int m)
+ vst (xtau, hh, mean, g);
+ vsp (w1, hh, -1.0, g);
+ vvt (w2, w1, jmean, g);
+ vvm (xtau, xtau, w2, g);
+
+ vsp (xtau, xtau, -jackest, g);
+ vvt (xtau, xtau, xtau, g);
+ vvd (xtau, xtau, w1, g);
+ yvar = asum (xtau, g) / (double) g;
+ *est = jackest;
+ *sig = 0.0;
+ if (yvar > 0)
+ *sig = sqrt (yvar);
+
+ free (tdiff);
+ free (hh);
+ free (xtau);
+ free (w1);
+ free (w2);
+
+}
+
+int
+modehprob (int n, int a, int m)
// mode of hypergeometric.
{
- double v ;
- int mode ;
+ double v;
+ int mode;
- v = (double) (a+1)*(m+1) / (double) (n+2) ;
- mode = nnint (v-0.5) ;
+ v = (double) (a + 1) * (m + 1) / (double) (n + 2);
+ mode = nnint (v - 0.5);
-/**
- v solves equation P(v) = P(v-1)
- since P is log-concave it follows that mode is in
- (v-1, v)
-*/
-
-/**
- for (;;) {
- if (loghprob(n, a, m, mode) < loghprob(n, a, m, mode+1)) {
+ /**
+ v solves equation P(v) = P(v-1)
+ since P is log-concave it follows that mode is in
+ (v-1, v)
+ */
+
+ /**
+ for (;;) {
+ if (loghprob(n, a, m, mode) < loghprob(n, a, m, mode+1)) {
mode = mode + 1 ;
continue ;
- }
- if (loghprob(n, a, m, mode) < loghprob(n, a, m, mode-1)) {
+ }
+ if (loghprob(n, a, m, mode) < loghprob(n, a, m, mode-1)) {
mode = mode - 1 ;
continue ;
- }
- break ;
- }
-*/
+ }
+ break ;
+ }
+ */
- return mode ;
+ return mode;
}
-
-
void
-calcfc(double *c, int g, double rho)
+calcfc (double *c, int g, double rho)
// calculate spectral weights to correct correlation
{
- double *l, *d ;
- int i,k;
- double pi ;
+ double *l, *d;
+ int i, k;
+ double pi;
- pi = 2.0*acos(0.0) ;
- ZALLOC(l, g, double) ;
- ZALLOC(d, g, double) ;
- for(k=0;k<g;k++)
+ pi = 2.0 * acos (0.0);
+ ZALLOC(l, g, double);
+ ZALLOC(d, g, double);
+ for (k = 0; k < g; k++)
{
- l[k] = 1 + 2*rho*cos((2.0*pi*k)/g);
- d[k] = 1.0/sqrt(l[k]);
+ l[k] = 1 + 2 * rho * cos ((2.0 * pi * k) / g);
+ d[k] = 1.0 / sqrt (l[k]);
}
- vzero(c, g) ;
+ vzero (c, g);
- for(i=0;i<g;i++)
+ for (i = 0; i < g; i++)
{
c[i] = 0;
- for(k=0;k<g;k++)
- {
- c[i] += d[k]*cos((2.0*pi*k*i)/(double) g);
- }
+ for (k = 0; k < g; k++)
+ {
+ c[i] += d[k] * cos ((2.0 * pi * k * i) / (double) g);
+ }
}
- vst(c, c, 1.0/ (double) g, g) ;
+ vst (c, c, 1.0 / (double) g, g);
- free(l) ;
- free(d) ;
+ free (l);
+ free (d);
}
+
void
-circconv(double *jp, double *c, double *jmean, int g)
+circconv (double *jp, double *c, double *jmean, int g)
{
- double *ww ;
- int i, k ;
+ double *ww;
+ int i, k;
- ZALLOC(ww, 2*g, double) ;
- copyarr(c, ww, g) ;
- copyarr(c, ww+g, g) ;
+ ZALLOC(ww, 2 * g, double);
+ copyarr (c, ww, g);
+ copyarr (c, ww + g, g);
- vzero(jp, g) ;
- for (i=0; i<g; i++) {
- for (k=0; k<g; k++) {
- jp[i] += jmean[k]*ww[g+i-k] ;
- }
- }
+ vzero (jp, g);
+ for (i = 0; i < g; i++)
+ {
+ for (k = 0; k < g; k++)
+ {
+ jp[i] += jmean[k] * ww[g + i - k];
+ }
+ }
- free(ww) ;
+ free (ww);
}
-double bino(int a, int b)
+
+double
+bino (int a, int b)
{
- if (b>a) return 0.0 ;
- if (a<0) fatalx("bad bino\n") ;
- if (b<0) fatalx("bad bino\n") ;
- if (a>=bcosize) fatalx("bino overflow %d %d\n", a, bcosize-1) ;
-
- return bcotable[a][b] ;
+ if (b > a)
+ return 0.0;
+ if (a < 0)
+ fatalx ("bad bino\n");
+ if (b < 0)
+ fatalx ("bad bino\n");
+ if (a >= bcosize)
+ fatalx ("bino overflow %d %d\n", a, bcosize - 1);
+ return bcotable[a][b];
}
-void setbino(int maxbco)
-{
- int i, j ;
- if (maxbco<bcosize) return ;
- if (bcosize>=0) destroy_bino() ;
- bcotable = initarray_2Ddouble(maxbco+1, maxbco+1, 0.0) ;
- bcosize = maxbco+1 ;
- for (i=0; i<=maxbco; ++i) {
- for (j=0; j<=i; ++j) {
- bcotable[i][j] = exp(logbino(i,j)) ;
- }
+
+void
+setbino (int maxbco)
+{
+ int i, j;
+ if (maxbco < bcosize)
+ return;
+ if (bcosize >= 0)
+ destroy_bino ();
+ bcotable = initarray_2Ddouble (maxbco + 1, maxbco + 1, 0.0);
+ bcosize = maxbco + 1;
+ for (i = 0; i <= maxbco; ++i)
+ {
+ for (j = 0; j <= i; ++j)
+ {
+ bcotable[i][j] = exp (logbino (i, j));
+ }
}
-}
+}
-void destroy_bino()
+void
+destroy_bino ()
{
- if (bcosize < 0) return ;
- free2D(&bcotable, bcosize) ;
- bcosize = -1 ;
+ if (bcosize < 0)
+ return;
+ free2D (&bcotable, bcosize);
+ bcosize = -1;
}
-
diff --git a/src/nicksrc/strsubs.c b/src/nicksrc/strsubs.c
index 5489424..58ab14f 100644
--- a/src/nicksrc/strsubs.c
+++ b/src/nicksrc/strsubs.c
@@ -9,481 +9,567 @@
#include <sys/types.h>
#include <sys/stat.h>
-
#define MAXSTR 10000
#define MAXFF 50
#include "strsubs.h"
#include "vsubs.h"
-extern int errno ;
-
+extern int errno;
-int oldsplitup(char *strin, char**spt, int maxpt)
+int
+oldsplitup (char *strin, char**spt, int maxpt)
/**
retained in case there are compatibility problems
-*/
-{
- char *s1, *s2, *sx ;
- char *str ;
- int i, len, num ;
-
- len = strlen(strin) ;
- if (len==0) return 0 ;
- ZALLOC(str, 2*len, char) ;
- num = 0 ;
- sx = strin ;
- for (i=0; i<maxpt; i++) {
- s1 = fnwhite(sx) ;
- if (s1==NULL) {
- break ;
- }
- s2 = fwhite(s1) ;
- if (s2==NULL) {
- s2 = s1+strlen(s1) ;
- }
- s2-- ; /* now points at last character of next word */
- len = s2-s1+1 ;
- strncpy(str,s1,len) ;
- str[len] = '\0' ;
- spt[num] = strdup(str) ;
- ++num ;
- sx = s2+1 ;
- }
- freestring(&str) ;
- return num ;
-}
-
-void freeup (char *strpt[],int numpt)
+ */
+{
+ char *s1, *s2, *sx;
+ char *str;
+ int i, len, num;
+
+ len = strlen (strin);
+ if (len == 0)
+ return 0;
+ ZALLOC(str, 2*len, char);
+ num = 0;
+ sx = strin;
+ for (i = 0; i < maxpt; i++)
+ {
+ s1 = fnwhite (sx);
+ if (s1 == NULL)
+ {
+ break;
+ }
+ s2 = fwhite (s1);
+ if (s2 == NULL)
+ {
+ s2 = s1 + strlen (s1);
+ }
+ s2--; /* now points at last character of next word */
+ len = s2 - s1 + 1;
+ strncpy (str, s1, len);
+ str[len] = '\0';
+ spt[num] = strdup (str);
+ ++num;
+ sx = s2 + 1;
+ }
+ freestring (&str);
+ return num;
+}
+
+void
+freeup (char *strpt[], int numpt)
/** free up array of strings */
{
- int i ;
- for (i=numpt-1; i>=0; i--) {
- if (strpt[i] != NULL) freestring(&strpt[i]) ;
+ int i;
+ for (i = numpt - 1; i >= 0; i--)
+ {
+ if (strpt[i] != NULL)
+ freestring (&strpt[i]);
}
}
-int first_word(char *string, char *xword, char *xrest)
+int
+first_word (char *string, char *xword, char *xrest)
/* first_word(string, *word, *rest)
- Break the string into the first word and the rest. Both word and
-rest begin with non-white space, unless rest is null.
- Return:
- 0 means string is all white
- 1 means word is non-white, but rest is white
- 2 means word and rest are non-white
+ Break the string into the first word and the rest. Both word and
+ rest begin with non-white space, unless rest is null.
+ Return:
+ 0 means string is all white
+ 1 means word is non-white, but rest is white
+ 2 means word and rest are non-white
- If string and rest coincide, string will be overwritten
+ If string and rest coincide, string will be overwritten
-*/
-{
- char *spt, x ;
- char *ss = NULL, *sx ;
- int l1,l2 ;
-
- ss = strdup(string) ;
- if (ss==NULL) {
- printf("strdup fails\n") ;
- printf("%s\n",string) ;
- fatalx("first_word... strdup fails\n") ;
- }
- fflush(stdout) ;
- spt = ss ;
- xword[0]=xrest[0] = '\0' ;
- if ((spt = fnwhite(ss)) == NULL) {
- free(ss) ;
- return 0 ;
- }
- sx = fwhite(spt) ;
- if (sx==NULL) {
- strcpy(xword,spt) ;
- free (ss) ;
- return 1 ;
+ */
+{
+ char *spt, x;
+ char *ss = NULL, *sx;
+ int l1, l2;
+
+ ss = strdup (string);
+ if (ss == NULL)
+ {
+ printf ("strdup fails\n");
+ printf ("%s\n", string);
+ fatalx ("first_word... strdup fails\n");
+ }
+ fflush (stdout);
+ spt = ss;
+ xword[0] = xrest[0] = '\0';
+ if ((spt = fnwhite (ss)) == NULL)
+ {
+ free (ss);
+ return 0;
+ }
+ sx = fwhite (spt);
+ if (sx == NULL)
+ {
+ strcpy (xword, spt);
+ free (ss);
+ return 1;
}
- l1 = sx-spt ;
- l2 = strlen(sx) - 1 ;
- *sx = '\0' ;
- strcpy(xword,spt) ;
- if (l2 <= 0) {
- free(ss) ;
- return 1 ;
+ l1 = sx - spt;
+ l2 = strlen (sx) - 1;
+ *sx = '\0';
+ strcpy (xword, spt);
+ if (l2 <= 0)
+ {
+ free (ss);
+ return 1;
}
- sx = fnwhite(sx+1) ;
- if (sx==NULL) {
- free (ss) ;
- return 1 ;
+ sx = fnwhite (sx + 1);
+ if (sx == NULL)
+ {
+ free (ss);
+ return 1;
}
- strcpy(xrest,sx) ;
- free (ss) ;
- return 2 ;
+ strcpy (xrest, sx);
+ free (ss);
+ return 2;
}
-char *fnwhite (char * ss)
+char *
+fnwhite (char * ss)
/* return first non white space */
{
- char *x ;
- if (ss==NULL) fatalx("fnwhite: logic bug\n") ;
- for (x= ss; *x != '\0'; ++x) {
- if (!isspace(*x)) return x ;
- }
- return NULL ;
+ char *x;
+ if (ss == NULL)
+ fatalx ("fnwhite: logic bug\n");
+ for (x = ss; *x != '\0'; ++x)
+ {
+ if (!isspace(*x))
+ return x;
+ }
+ return NULL;
}
-char *ftab (char *ss)
+char *
+ftab (char *ss)
/* return first tab */
{
- char *x ;
- int n ;
- for (x= ss; *x != '\0'; ++x) {
- if (*x == CTAB) return x ;
- }
- return NULL ;
+ char *x;
+ int n;
+ for (x = ss; *x != '\0'; ++x)
+ {
+ if (*x == CTAB)
+ return x;
+ }
+ return NULL;
}
-
-char *fwhite (char * ss)
+
+char *
+fwhite (char * ss)
/* return first white space */
{
- char *x ;
- int n ;
- for (x= ss; *x != '\0'; ++x) {
- if (isspace(*x)) return x ;
- }
- return NULL ;
+ char *x;
+ int n;
+ for (x = ss; *x != '\0'; ++x)
+ {
+ if (isspace(*x))
+ return x;
+ }
+ return NULL;
}
-
+
static char Estr[MAXSTR];
-void fatalx( char *fmt, ...)
-{ va_list args;
+void
+fatalx (char *fmt, ...)
+{
+ va_list args;
- va_start( args, fmt);
- vsprintf( Estr, fmt, args);
- va_end( args);
- fflush(stdout) ;
+ va_start(args, fmt);
+ vsprintf (Estr, fmt, args);
+ va_end(args);
+ fflush (stdout);
- fprintf(stderr,"fatalx:\n%s",Estr) ;
- fflush(stderr) ;
- abort() ;
+ fprintf (stderr, "fatalx:\n%s", Estr);
+ fflush (stderr);
+ abort ();
}
-int NPisnumber (char c)
+int
+NPisnumber (char c)
/**
returns 1 if - + or digit
-*/
+ */
{
- if (isdigit(c)) return 1 ;
- if (c=='+') return 1 ;
- if (c=='-') return 1 ;
+ if (isdigit(c))
+ return 1;
+ if (c == '+')
+ return 1;
+ if (c == '-')
+ return 1;
- return 0 ;
+ return 0;
}
-int isnumword (char *str)
+int
+isnumword (char *str)
{
- int i, len, numpt ;
- char c ;
- len = strlen(str) ;
-
- numpt = 0 ;
- for (i=0; i<len; i++) {
- c = str[i] ;
-
- if ((c == '.') && (numpt==0) ) {
- ++numpt ;
- continue ;
- }
-
- if (!NPisnumber(c)) return NO ;
- if (!isdigit(c) && (i>0) ) return NO ;
- }
- return YES ;
+ int i, len, numpt;
+ char c;
+ len = strlen (str);
+
+ numpt = 0;
+ for (i = 0; i < len; i++)
+ {
+ c = str[i];
+
+ if ((c == '.') && (numpt == 0))
+ {
+ ++numpt;
+ continue;
+ }
+
+ if (!NPisnumber (c))
+ return NO;
+ if (!isdigit(c) && (i > 0))
+ return NO;
+ }
+ return YES;
}
-long seednum()
+long
+seednum ()
{
- long a, b, c, d ;
- struct tms tbuff ;
+ long a, b, c, d;
+ struct tms tbuff;
- a = (long) getpid() ;
- b = (long) getuid() ;
- d = times(&tbuff) ;
+ a = (long) getpid ();
+ b = (long) getuid ();
+ d = times (&tbuff);
- c = d ^ ((a + b) << 15) ;
+ c = d ^ ((a + b) << 15);
-
- return c ;
+ return c;
}
-int splitupwxbuff(char *strin, char **spt, int maxpt, char *bigbuff, int bigbufflen)
+int
+splitupwxbuff (char *strin, char **spt, int maxpt, char *bigbuff,
+ int bigbufflen)
// splits by white space; No zero length strings
{
- char *sx, *sy ;
- int num, len, k, klo ;
- int empty = YES ;
-
- len = strlen(strin) ;
- if (len>=bigbufflen) fatalx("(splitupwxbuff) overflow\n%s", strin) ;
- strcpy(bigbuff, strin) ;
- num = 0 ;
- for (k=0; k<len; ++k) {
- if (!isspace(bigbuff[k])) {
- empty = NO ;
- klo = k ;
- sx = bigbuff + k ;
- break ;
- }
- }
- if (empty) return 0 ;
- for (k=klo; k<len; ++k) {
- if (isspace(strin[k])) {
- bigbuff[k] = CNULL;
- if (num>=maxpt) break ;
- spt[num] = sx ;
- if (strlen(sx) > 0) ++num ;
- sx = bigbuff+k+1 ;
- }
- }
- if (num>=maxpt) return num ;
- spt[num] = sx ;
- if (strlen(sx) > 0) ++num ;
- return num ;
-}
-int splitupxbuff(char *strin, char **spt, int maxpt, char splitc, char *bigbuff, int bigbufflen)
-{
- char *sx, *sy ;
- int num, len, k, klo ;
- int empty = YES ;
-
- len = strlen(strin) ;
- if (len>=bigbufflen) fatalx("(splitupxbuff) overflow \n%s\n", strin) ;
- strcpy(bigbuff, strin) ;
- num = 0 ;
- for (k=0; k<len; ++k) {
- if (strin[k] != splitc) {
- empty = NO ;
- klo = k ;
- sx = bigbuff + k ;
- break ;
- }
- }
- if (empty) return 0 ;
- for (k=klo; k<len; ++k) {
- if (strin[k] == splitc) {
- bigbuff[k] = CNULL;
- if (num>=maxpt) fatalx("overflow\n") ;
- spt[num] = sx ;
- sx = bigbuff+k+1 ;
- ++num ;
- }
- }
- if (num>=maxpt) fatalx("overflow\n") ;
- spt[num] = sx ;
- ++num ;
- return num ;
-}
-
-int splitup(char *strin, char **spt, int maxpt)
-{
- char *bigb, **qpt ;
- int num, len, k ;
-
- if (strin==NULL) return 0 ;
- len = strlen(strin) ;
- ZALLOC(bigb, len+1, char) ;
- ZALLOC(qpt, maxpt, char *) ;
- num = splitupwxbuff(strin, qpt, maxpt, bigb, len+1) ;
- for (k=0; k<num; ++k) {
- spt[k] = strdup(qpt[k]) ;
- }
- free(bigb) ;
- free(qpt) ;
+ char *sx, *sy;
+ int num, len, k, klo;
+ int empty = YES;
+
+ len = strlen (strin);
+ if (len >= bigbufflen)
+ fatalx ("(splitupwxbuff) overflow\n%s", strin);
+ strcpy (bigbuff, strin);
+ num = 0;
+ for (k = 0; k < len; ++k)
+ {
+ if (!isspace(bigbuff[k]))
+ {
+ empty = NO;
+ klo = k;
+ sx = bigbuff + k;
+ break;
+ }
+ }
+ if (empty)
+ return 0;
+ for (k = klo; k < len; ++k)
+ {
+ if (isspace(strin[k]))
+ {
+ bigbuff[k] = CNULL;
+ if (num >= maxpt)
+ break;
+ spt[num] = sx;
+ if (strlen (sx) > 0)
+ ++num;
+ sx = bigbuff + k + 1;
+ }
+ }
+ if (num >= maxpt)
+ return num;
+ spt[num] = sx;
+ if (strlen (sx) > 0)
+ ++num;
return num;
}
-int splitupx(char *strin, char **spt, int maxpt, char splitc)
-{
- char *bigb, **qpt ;
- int num, len, k ;
-
- if (strin==NULL) return 0 ;
- len = strlen(strin) ;
- ZALLOC(bigb, len+1, char) ;
- ZALLOC(qpt, maxpt, char *) ;
- num = splitupxbuff(strin, qpt, maxpt, splitc, bigb, len+1) ;
- for (k=0; k<num; ++k) {
- spt[k] = strdup(qpt[k]) ;
- }
- free(bigb) ;
- free(qpt) ;
+int
+splitupxbuff (char *strin, char **spt, int maxpt, char splitc, char *bigbuff,
+ int bigbufflen)
+{
+ char *sx, *sy;
+ int num, len, k, klo;
+ int empty = YES;
+
+ len = strlen (strin);
+ if (len >= bigbufflen)
+ fatalx ("(splitupxbuff) overflow \n%s\n", strin);
+ strcpy (bigbuff, strin);
+ num = 0;
+ for (k = 0; k < len; ++k)
+ {
+ if (strin[k] != splitc)
+ {
+ empty = NO;
+ klo = k;
+ sx = bigbuff + k;
+ break;
+ }
+ }
+ if (empty)
+ return 0;
+ for (k = klo; k < len; ++k)
+ {
+ if (strin[k] == splitc)
+ {
+ bigbuff[k] = CNULL;
+ if (num >= maxpt)
+ fatalx ("overflow\n");
+ spt[num] = sx;
+ sx = bigbuff + k + 1;
+ ++num;
+ }
+ }
+ if (num >= maxpt)
+ fatalx ("overflow\n");
+ spt[num] = sx;
+ ++num;
return num;
}
-int split1 (char *strin, char *strpt[], char splitc)
-/*
-take a string and break it into 2 substrings separated by splitc ;
-numpt is number of words returned (1 or 2)
-*/
+int
+splitup (char *strin, char **spt, int maxpt)
{
- char rest[MAXSTR],str[MAXSTR],ww[MAXSTR] ;
- int len, i, l ;
+ char *bigb, **qpt;
+ int num, len, k;
+
+ if (strin == NULL)
+ return 0;
+ len = strlen (strin);
+ ZALLOC(bigb, len+1, char);
+ ZALLOC(qpt, maxpt, char *);
+ num = splitupwxbuff (strin, qpt, maxpt, bigb, len + 1);
+ for (k = 0; k < num; ++k)
+ {
+ spt[k] = strdup (qpt[k]);
+ }
+ free (bigb);
+ free (qpt);
+ return num;
+}
+int
+splitupx (char *strin, char **spt, int maxpt, char splitc)
+{
+ char *bigb, **qpt;
+ int num, len, k;
+
+ if (strin == NULL)
+ return 0;
+ len = strlen (strin);
+ ZALLOC(bigb, len+1, char);
+ ZALLOC(qpt, maxpt, char *);
+ num = splitupxbuff (strin, qpt, maxpt, splitc, bigb, len + 1);
+ for (k = 0; k < num; ++k)
+ {
+ spt[k] = strdup (qpt[k]);
+ }
+ free (bigb);
+ free (qpt);
+ return num;
+}
- strncpy(str,strin,MAXSTR) ;
- len = strlen(strin) ;
- for (i=0; i<len; i++) {
- if (str[i] == splitc) {
- l = i ;
- strncpy(ww, str, l) ;
- ww[l] = '\0' ;
- strpt[0] = strdup(ww) ;
- l = len-(i+1) ;
- if (l<=0) return 1 ;
- strncpy(rest,str+i+1,l) ;
- rest[l] = '\0' ;
- strpt[1] = strdup(rest) ;
- return 2 ;
- }
- }
- strpt[0] = strdup(strin) ;
- strpt[1] = NULL ;
- return 1 ;
+int
+split1 (char *strin, char *strpt[], char splitc)
+/*
+ take a string and break it into 2 substrings separated by splitc ;
+ numpt is number of words returned (1 or 2)
+ */
+{
+ char rest[MAXSTR], str[MAXSTR], ww[MAXSTR];
+ int len, i, l;
+
+ strncpy (str, strin, MAXSTR);
+ len = strlen (strin);
+ for (i = 0; i < len; i++)
+ {
+ if (str[i] == splitc)
+ {
+ l = i;
+ strncpy (ww, str, l);
+ ww[l] = '\0';
+ strpt[0] = strdup (ww);
+ l = len - (i + 1);
+ if (l <= 0)
+ return 1;
+ strncpy (rest, str + i + 1, l);
+ rest[l] = '\0';
+ strpt[1] = strdup (rest);
+ return 2;
+ }
+ }
+ strpt[0] = strdup (strin);
+ strpt[1] = NULL;
+ return 1;
}
-void printbl(int n)
+void
+printbl (int n)
{
- int i ;
- for (i=0; i<n; i++) {
- printf(" ") ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ printf (" ");
+ }
}
-void printnl()
+void
+printnl ()
{
- printf("\n") ;
+ printf ("\n");
}
-void striptrail(char *sss, char c)
+void
+striptrail (char *sss, char c)
/**
strip out trailing characters
c will usually be ' '
-*/
+ */
{
- int len, i ;
- len = strlen(sss) ;
- for (i=len-1; i>=0; --i) {
- if (sss[i] != c) return ;
- sss[i] = '\0' ;
- }
+ int len, i;
+ len = strlen (sss);
+ for (i = len - 1; i >= 0; --i)
+ {
+ if (sss[i] != c)
+ return;
+ sss[i] = '\0';
+ }
}
-void catx(char *sxout, char **spt, int n)
+void
+catx (char *sxout, char **spt, int n)
{
- int i ;
- sxout[0] = CNULL ;
-
- for (i=0; i<n; i++) {
- strcat(sxout,spt[i]) ;
- }
+ int i;
+ sxout[0] = CNULL;
+ for (i = 0; i < n; i++)
+ {
+ strcat (sxout, spt[i]);
+ }
}
-void catxx(char *sxout, char **spt, int n)
+void
+catxx (char *sxout, char **spt, int n)
/**
like catx but with space between items
-*/
+ */
{
- int i ;
- sxout[0] = CNULL ;
-
- for (i=0; i<n; i++) {
- strcat(sxout,spt[i]) ;
- if (i<(n-1)) strcat(sxout, " ") ;
- }
+ int i;
+ sxout[0] = CNULL;
+
+ for (i = 0; i < n; i++)
+ {
+ strcat (sxout, spt[i]);
+ if (i < (n - 1))
+ strcat (sxout, " ");
+ }
}
-void catxc(char *sxout, char **spt, int n, char c)
+void
+catxc (char *sxout, char **spt, int n, char c)
/**
like catx but with char c between items
-*/
+ */
{
- int i ;
- char cc[2] ;
+ int i;
+ char cc[2];
- sxout[0] = CNULL ;
+ sxout[0] = CNULL;
- cc[0] = c ;
- cc[1] = CNULL ;
+ cc[0] = c;
+ cc[1] = CNULL;
- for (i=0; i<n; i++) {
- strcat(sxout,spt[i]) ;
- if (i<(n-1)) strcat(sxout, cc) ;
- }
+ for (i = 0; i < n; i++)
+ {
+ strcat (sxout, spt[i]);
+ if (i < (n - 1))
+ strcat (sxout, cc);
+ }
}
-void makedfn(char *dirname, char *fname, char *outname, int maxstr)
+void
+makedfn (char *dirname, char *fname, char *outname, int maxstr)
/** makes full path name.
- If fname starts with '/' or dirname = NULL we
- so nothing.
- outname MUST be allocated of length at least maxstr
-*/
+ If fname starts with '/' or dirname = NULL we
+ so nothing.
+ outname MUST be allocated of length at least maxstr
+ */
{
- char *ss ;
- int len ;
-
- if ((dirname==NULL) || (fname[0]=='/')) {
-/* if fname starts with / we assume absolute pathname */
- len = strlen(fname) ;
- if (len>=maxstr) fatalx("(makedfn) maxstr too short\n") ;
- strcpy(outname, fname) ;
- return ;
+ char *ss;
+ int len;
+
+ if ((dirname == NULL) || (fname[0] == '/'))
+ {
+ /* if fname starts with / we assume absolute pathname */
+ len = strlen (fname);
+ if (len >= maxstr)
+ fatalx ("(makedfn) maxstr too short\n");
+ strcpy (outname, fname);
+ return;
}
- len = strlen(dirname) + strlen(fname)+1 ;
- if (len>=maxstr) fatalx("(makedfn) maxstr too short\n") ;
+ len = strlen (dirname) + strlen (fname) + 1;
+ if (len >= maxstr)
+ fatalx ("(makedfn) maxstr too short\n");
- ss = outname ;
- strcpy(ss,dirname) ;
- ss = ss+strlen(dirname) ;
- ss[0] = '/' ;
- ++ss ;
- strcpy(ss,fname) ;
+ ss = outname;
+ strcpy (ss, dirname);
+ ss = ss + strlen (dirname);
+ ss[0] = '/';
+ ++ss;
+ strcpy (ss, fname);
}
-int substringx (char **ap, char *inx, char *outx, int niter)
+int
+substringx (char **ap, char *inx, char *outx, int niter)
/**
*ap is original string
all occurrences of inx are substituted with outx
can loop so be careful !!
NB. ap must be on heap. Fixed allocation not supported
-*/
-{
- char *a, *pt ;
- char *str ;
- int len, off, x ;
-
- if (niter>50) fatalx("bad string replacement\n %s\n", *ap) ;
-
- a = *ap ;
- len = strlen(a) + strlen(inx) + strlen(outx) + 1 ;
- pt = strstr(a, inx) ;
- if (pt == NULL) {
- return 0 ;
- }
- ZALLOC(str, len, char) ;
- off = pt - a ;
- strncpy(str,a,off) ;
- strcpy(str+off, outx) ;
- x = strlen(outx) ;
- pt += strlen(inx) ;
- strcpy(str+off+x, pt) ;
-
- freestring(&a) ;
- *ap = strdup(str) ;
- free(str) ;
- return (1 + substringx(ap, inx, outx, niter+1)) ;
-}
-
-int substring (char **ap, char *inx, char *outx)
+ */
+{
+ char *a, *pt;
+ char *str;
+ int len, off, x;
+
+ if (niter > 50)
+ fatalx ("bad string replacement\n %s\n", *ap);
+
+ a = *ap;
+ len = strlen (a) + strlen (inx) + strlen (outx) + 1;
+ pt = strstr (a, inx);
+ if (pt == NULL)
+ {
+ return 0;
+ }
+ ZALLOC(str, len, char);
+ off = pt - a;
+ strncpy (str, a, off);
+ strcpy (str + off, outx);
+ x = strlen (outx);
+ pt += strlen (inx);
+ strcpy (str + off + x, pt);
+
+ freestring (&a);
+ *ap = strdup (str);
+ free (str);
+ return (1 + substringx (ap, inx, outx, niter + 1));
+}
+
+int
+substring (char **ap, char *inx, char *outx)
/**
*ap is original string
all occurrences of inx are substituted with outx
@@ -491,884 +577,1063 @@ int substring (char **ap, char *inx, char *outx)
NB. ap must be on heap. Fixed allocation not supported
-*/
+ */
{
- return (substringx(ap, inx, outx, 0)) ;
+ return (substringx (ap, inx, outx, 0));
}
-
-
-int numcols(char *name)
+int
+numcols (char *name)
// number of cols
{
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXSTR] ;
- char *sx ;
- int nsplit, num=0 ;
-
- if (name == NULL) fatalx("(numlines) no name") ;
- openit(name, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- freeup(spt, nsplit) ;
- fclose(fff) ;
- return nsplit ;
- }
-}
-
-int numlines(char *name)
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXSTR];
+ char *sx;
+ int nsplit, num = 0;
+
+ if (name == NULL)
+ fatalx ("(numlines) no name");
+ openit (name, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ freeup (spt, nsplit);
+ fclose (fff);
+ return nsplit;
+ }
+}
+
+int
+numlines (char *name)
// number of lines no comments or blanks
{
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXSTR] ;
- char *sx ;
- int nsplit, num=0 ;
-
- num = 0;
- if (name == NULL) fatalx("(numlines) no name") ;
- openit(name, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- ++num ;
- freeup(spt, nsplit) ;
- }
- fclose(fff) ;
- return num ;
-}
-
-int ftest(char *sss)
+ FILE *fff;
+ char line[MAXSTR];
+ char *spt[MAXSTR];
+ char *sx;
+ int nsplit, num = 0;
+
+ num = 0;
+ if (name == NULL)
+ fatalx ("(numlines) no name");
+ openit (name, &fff, "r");
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, MAXFF);
+ if (nsplit == 0)
+ continue;
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ ++num;
+ freeup (spt, nsplit);
+ }
+ fclose (fff);
+ return num;
+}
+
+int
+ftest (char *sss)
// can we open file for reading
{
- FILE *fdummy ;
+ FILE *fdummy;
- fdummy = fopen(sss, "r") ;
+ fdummy = fopen (sss, "r");
- if (fdummy == NULL) return NO ;
- fclose(fdummy) ;
- return YES ;
+ if (fdummy == NULL)
+ return NO;
+ fclose (fdummy);
+ return YES;
}
-void openit(char *name, FILE **fff, char *type)
+void
+openit (char *name, FILE **fff, char *type)
{
- char *ss ;
- if (name==NULL) fatalx("\n(openit) null name\n") ;
- *fff = fopen(name,type) ;
- if (*fff==NULL) {
- ss = strerror(errno) ;
- printf("bad open %s\n", name) ;
+ char *ss;
+ if (name == NULL)
+ fatalx ("\n(openit) null name\n");
+ *fff = fopen (name, type);
+ if (*fff == NULL)
+ {
+ ss = strerror (errno);
+ printf ("bad open %s\n", name);
// system("lsof | fgrep np29") ;
- fatalx("can't open file %s of type %s\n error info: %s\n",name,type,ss) ;
- }
-}
-
-int
-getxx(double **xx, int maxrow, int numcol, char *fname)
-{
-
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff ;
- FILE *fff ;
- int nbad = 0 ;
-
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- maxff = MAX(MAXFF, numcol) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<numcol) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- xx[i][num] = atof(spt[i]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
-}
-
-double clocktime()
-{
- double xtime ;
- double y ;
-
- xtime = (double) clock() ;
- y = xtime / (double) CLOCKS_PER_SEC ;
- return y ;
+ fatalx ("can't open file %s of type %s\n error info: %s\n", name, type,
+ ss);
+ }
+}
+
+int
+getxx (double **xx, int maxrow, int numcol, char *fname)
+{
+
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff;
+ FILE *fff;
+ int nbad = 0;
+
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
+ }
+ maxff = MAX(MAXFF, numcol);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < numcol)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ xx[i][num] = atof (spt[i]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
+}
+
+double
+clocktime ()
+{
+ double xtime;
+ double y;
+
+ xtime = (double) clock ();
+ y = xtime / (double) CLOCKS_PER_SEC;
+ return y;
}
int
-indxstring(char **namelist, int len, char *strid)
+indxstring (char **namelist, int len, char *strid)
// look for string in list. Was called indxindex
{
- int k ;
- for (k=0; k< len; k++) {
- if (namelist[k] == NULL) continue ;
- if (strcmp(namelist[k], strid) == 0) return k ;
- }
- return -1 ;
+ int k;
+ for (k = 0; k < len; k++)
+ {
+ if (namelist[k] == NULL)
+ continue;
+ if (strcmp (namelist[k], strid) == 0)
+ return k;
+ }
+ return -1;
}
int
-indxstringr(char **namelist, int len, char *strid)
+indxstringr (char **namelist, int len, char *strid)
// look for string in list. Searches array in reverse ;
{
- int k ;
- for (k=len-1; k >=0 ; k--) {
- if (namelist[k] == NULL) continue ;
- if (strcmp(namelist[k], strid) == 0) return k ;
- }
- return -1 ;
+ int k;
+ for (k = len - 1; k >= 0; k--)
+ {
+ if (namelist[k] == NULL)
+ continue;
+ if (strcmp (namelist[k], strid) == 0)
+ return k;
+ }
+ return -1;
}
-int
-getnameslohi(char ****pnames, int maxrow, int numcol, char *fname, int lo, int hi)
+int
+getnameslohi (char ****pnames, int maxrow, int numcol, char *fname, int lo,
+ int hi)
{
// count is base 1
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff, numcolp, lcount=0 ;
- FILE *fff ;
- int nbad = 0 ;
- char ***names ;
-
- names = *pnames ;
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- numcolp = numcol + 1 ;
- maxff = MAX(MAXFF, numcolp) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<numcol) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- ++lcount ;
- if ((lcount<lo) || (lcount>hi)) {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- names[i][num] = strdup(spt[i]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
-}
-
-int
-getnames(char ****pnames, int maxrow, int numcol, char *fname)
-{
-
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff, numcolp ;
- FILE *fff ;
- int nbad = 0 ;
- char ***names ;
-
- names = *pnames ;
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- numcolp = numcol + 1 ;
- maxff = MAX(MAXFF, numcolp) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<numcol) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- names[i][num] = strdup(spt[i]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
-}
-
-int
-getxxnames(char ***pnames, double **xx, int maxrow, int numcol, char *fname)
-{
-
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff, numcolp ;
- FILE *fff ;
- int nbad = 0 ;
- char **names = NULL ;
-
- if (pnames != NULL) names = *pnames ;
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- numcolp = numcol + 1 ;
- maxff = MAX(MAXFF, numcolp) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (names != NULL) names[num] = strdup(sx) ;
- if (nsplit<numcolp) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- xx[i][num] = atof(spt[i+1]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
-}
-
-int
-getxxnamesf(char ***pnames, double **xx, int maxrow, int numcol, FILE *fff)
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff, numcolp, lcount = 0;
+ FILE *fff;
+ int nbad = 0;
+ char ***names;
+
+ names = *pnames;
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
+ }
+ numcolp = numcol + 1;
+ maxff = MAX(MAXFF, numcolp);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < numcol)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ ++lcount;
+ if ((lcount < lo) || (lcount > hi))
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ names[i][num] = strdup (spt[i]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
+}
+
+int
+getnames (char ****pnames, int maxrow, int numcol, char *fname)
+{
+
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff, numcolp;
+ FILE *fff;
+ int nbad = 0;
+ char ***names;
+
+ names = *pnames;
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
+ }
+ numcolp = numcol + 1;
+ maxff = MAX(MAXFF, numcolp);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < numcol)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ names[i][num] = strdup (spt[i]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
+}
+
+int
+getxxnames (char ***pnames, double **xx, int maxrow, int numcol, char *fname)
+{
+
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff, numcolp;
+ FILE *fff;
+ int nbad = 0;
+ char **names = NULL;
+
+ if (pnames != NULL)
+ names = *pnames;
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
+ }
+ numcolp = numcol + 1;
+ maxff = MAX(MAXFF, numcolp);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (names != NULL)
+ names[num] = strdup (sx);
+ if (nsplit < numcolp)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ xx[i][num] = atof (spt[i + 1]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
+}
+
+int
+getxxnamesf (char ***pnames, double **xx, int maxrow, int numcol, FILE *fff)
/**
-like getxxnames but file already open
-*/
+ like getxxnames but file already open
+ */
{
#define MAXFF 50
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff, numcolp ;
- int nbad = 0 ;
- char **names ;
-
- if (pnames != NULL) names = *pnames ;
-
- numcolp = numcol + 1 ;
- maxff = MAX(MAXFF, numcolp) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (names != NULL) names[num] = strdup(sx) ;
- if (nsplit<numcolp) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- xx[i][num] = atof(spt[i+1]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- return num ;
-}
-
-
-int
-getss(char **ss, char *fname)
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff, numcolp;
+ int nbad = 0;
+ char **names;
+
+ if (pnames != NULL)
+ names = *pnames;
+
+ numcolp = numcol + 1;
+ maxff = MAX(MAXFF, numcolp);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (names != NULL)
+ names[num] = strdup (sx);
+ if (nsplit < numcolp)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ xx[i][num] = atof (spt[i + 1]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ return num;
+}
+
+int
+getss (char **ss, char *fname)
/**
get list of names
-*/
-{
-
- char line[MAXSTR] ;
- char qqq[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff ;
- FILE *fff ;
-
-
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- maxff = MAXFF ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<1) {
- continue ;
- }
- ss[num] = strdup(spt[0]) ;
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
-}
-char revchar(char c) {
- char cc ;
-
- cc = toupper(c) ;
- if (cc=='A') return 'T' ;
- if (cc=='C') return 'G' ;
- if (cc=='G') return 'C' ;
- if (cc=='T') return 'A' ;
-
- return c ;
-}
-
-void crevcomp(char *sout, char *sin)
-{
- char *sss, c, cout ;
- int len ;
- int i, j, t;
-
- len = strlen(sin) ;
- ZALLOC(sss, len+1, char) ;
- sss[len] = CNULL ;
-
- for (i=0; i<len; ++i) {
- j = len-i-1 ;
- c = sin[i] ;
- t = base2num(c) ;
- if (t<0) {
- sss[j] = c ;
- continue ;
+ */
+{
+
+ char line[MAXSTR];
+ char qqq[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff;
+ FILE *fff;
+
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
}
- cout = num2base(3-t) ;
- if (islower(c)) cout = tolower(cout) ;
- sss[j] = cout ;
- }
- strcpy(sout, sss) ;
- free(sss) ;
-}
-
-char *int_string(int a, int len, int base)
-{
- static char ss[100] ;
- int t = a, k, i ;
- char *binary = "01" ;
-
- ss[len] = CNULL ;
- for (i=0; i<len; i++) {
- k = t % base ;
- ss[len-i-1] = '0' + k ;
- t = t/base ;
- }
- return ss ;
-// fragile
+ maxff = MAXFF;
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ if (nsplit < 1)
+ {
+ continue;
+ }
+ ss[num] = strdup (spt[0]);
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
+}
+char
+revchar (char c)
+{
+ char cc;
+
+ cc = toupper(c);
+ if (cc == 'A')
+ return 'T';
+ if (cc == 'C')
+ return 'G';
+ if (cc == 'G')
+ return 'C';
+ if (cc == 'T')
+ return 'A';
+
+ return c;
}
-char *binary_string(int a, int len)
+
+void
+crevcomp (char *sout, char *sin)
{
- static char ss[100] ;
- int t = a, k, i ;
- char *binary = "01" ;
+ char *sss, c, cout;
+ int len;
+ int i, j, t;
+
+ len = strlen (sin);
+ ZALLOC(sss, len+1, char);
+ sss[len] = CNULL;
+
+ for (i = 0; i < len; ++i)
+ {
+ j = len - i - 1;
+ c = sin[i];
+ t = base2num (c);
+ if (t < 0)
+ {
+ sss[j] = c;
+ continue;
+ }
+ cout = num2base (3 - t);
+ if (islower(c))
+ cout = tolower(cout);
+ sss[j] = cout;
+ }
+ strcpy (sout, sss);
+ free (sss);
+}
- ss[len] = CNULL ;
- for (i=0; i<len; i++) {
- k = t % 2 ;
- ss[len-i-1] = binary[k] ;
- t = t/2 ;
- }
- return ss ;
+char *
+int_string (int a, int len, int base)
+{
+ static char ss[100];
+ int t = a, k, i;
+ char *binary = "01";
+
+ ss[len] = CNULL;
+ for (i = 0; i < len; i++)
+ {
+ k = t % base;
+ ss[len - i - 1] = '0' + k;
+ t = t / base;
+ }
+ return ss;
+// fragile
+}
+char *
+binary_string (int a, int len)
+{
+ static char ss[100];
+ int t = a, k, i;
+ char *binary = "01";
+
+ ss[len] = CNULL;
+ for (i = 0; i < len; i++)
+ {
+ k = t % 2;
+ ss[len - i - 1] = binary[k];
+ t = t / 2;
+ }
+ return ss;
// fragile
}
-char num2iub(int num) {
+char
+num2iub (int num)
+{
- char *iubstring = "ACGTMRWSYKVHDBX" ;
- char c ;
+ char *iubstring = "ACGTMRWSYKVHDBX";
+ char c;
- c = '?' ;
- if (num<0) return c ;
- if (num>14) return c ;
+ c = '?';
+ if (num < 0)
+ return c;
+ if (num > 14)
+ return c;
- return iubstring[num] ;
+ return iubstring[num];
}
-int iub2num(char c) {
+int
+iub2num (char c)
+{
- char *iubstring = "ACGTMRWSYKVHDBX" ;
- int t ;
- char *sx ;
+ char *iubstring = "ACGTMRWSYKVHDBX";
+ int t;
+ char *sx;
- sx = strchr(iubstring, c) ;
- if (sx == NULL) return -1 ;
- return sx - iubstring ;
+ sx = strchr (iubstring, c);
+ if (sx == NULL)
+ return -1;
+ return sx - iubstring;
}
-char num2base (int num)
+char
+num2base (int num)
{
- char *bases ="ACGT", c ;
- c = '?' ;
- if (num<0) return c ;
- if (num>3) return c ;
- return bases[num] ;
+ char *bases = "ACGT", c;
+ c = '?';
+ if (num < 0)
+ return c;
+ if (num > 3)
+ return c;
+ return bases[num];
}
-int base2num(char c)
+int
+base2num (char c)
{
- char cc ;
-
- cc = toupper(c) ;
-
- switch (cc) {
- case 'A': return 0;
- break ;
- case 'C': return 1;
- break ;
- case 'G': return 2;
- break ;
- case 'T': return 3;
- break ;
- default: return -1 ;
+ char cc;
+
+ cc = toupper(c);
+
+ switch (cc)
+ {
+ case 'A':
+ return 0;
+ break;
+ case 'C':
+ return 1;
+ break;
+ case 'G':
+ return 2;
+ break;
+ case 'T':
+ return 3;
+ break;
+ default:
+ return -1;
}
}
-int string_binary(char *sx)
+int
+string_binary (char *sx)
{
- int *aa, len, i, t ;
- char c ;
+ int *aa, len, i, t;
+ char c;
- len = strlen(sx) ;
- ZALLOC(aa, len, int) ;
+ len = strlen (sx);
+ ZALLOC(aa, len, int);
- for (i=0; i<len; i++) {
+ for (i = 0; i < len; i++)
+ {
- c = sx[i] ;
- if (c == '0') continue ;
- if (c != '1') fatalx("bad string: %s\n", sx) ;
- aa[i] = 1;
- }
- t = kodeitb(aa, len, 2) ;
- free(aa) ;
- return t ;
+ c = sx[i];
+ if (c == '0')
+ continue;
+ if (c != '1')
+ fatalx ("bad string: %s\n", sx);
+ aa[i] = 1;
+ }
+ t = kodeitb (aa, len, 2);
+ free (aa);
+ return t;
}
-void freestring(char **ss)
+void
+freestring (char **ss)
/* note extra indirection */
{
- if (*ss == NULL) return ;
- free(*ss) ;
- *ss = NULL ;
+ if (*ss == NULL)
+ return;
+ free (*ss);
+ *ss = NULL;
}
-void copystrings(char **sa, char **sb, int n)
+void
+copystrings (char **sa, char **sb, int n)
{
- int i ;
- for (i=0; i<n; ++i) {
- sb[i] = strdup(sa[i]) ;
- }
+ int i;
+ for (i = 0; i < n; ++i)
+ {
+ sb[i] = strdup (sa[i]);
+ }
}
-void printstringsw(char **ss, int n, int slen, int width)
+void
+printstringsw (char **ss, int n, int slen, int width)
{
- int k, kmod ;
- char fmt[10], s1[5] ;
-
- sprintf(s1, "%ds", slen) ;
- strcpy (fmt, "%") ;
- strcat(fmt, s1) ;
-
- for (k=0; k<n; ++k) {
- if (ss[k] != NULL) printf(fmt, ss[k]) ;
- else printf(fmt, "NULL") ;
- kmod = (k+1) % width ;
- if ((kmod == 0) && (k < (n-1))) {
- printnl() ;
- }
- }
- printnl() ;
+ int k, kmod;
+ char fmt[10], s1[5];
+
+ sprintf (s1, "%ds", slen);
+ strcpy (fmt, "%");
+ strcat (fmt, s1);
+
+ for (k = 0; k < n; ++k)
+ {
+ if (ss[k] != NULL)
+ printf (fmt, ss[k]);
+ else
+ printf (fmt, "NULL");
+ kmod = (k + 1) % width;
+ if ((kmod == 0) && (k < (n - 1)))
+ {
+ printnl ();
+ }
+ }
+ printnl ();
}
-void printstrings(char **ss, int n)
+void
+printstrings (char **ss, int n)
{
- int k ;
-
- for (k=0; k<n; ++k) {
- if (ss[k] != NULL) printf("%s", ss[k]) ;
- else printf("%s", "NULL") ;
- printnl() ;
- }
+ int k;
+
+ for (k = 0; k < n; ++k)
+ {
+ if (ss[k] != NULL)
+ printf ("%s", ss[k]);
+ else
+ printf ("%s", "NULL");
+ printnl ();
+ }
}
-int ridfile(char *fname)
+int
+ridfile (char *fname)
{
- int t ;
+ int t;
- chmod(fname, 0777) ;
- t = unlink(fname) ;
- return t ;
+ chmod (fname, 0777);
+ t = unlink (fname);
+ return t;
}
-char compbase(char x)
+char
+compbase (char x)
// upper case !!
// return complement
{
- if (x=='A') return 'T' ;
- if (x=='C') return 'G' ;
- if (x=='G') return 'C' ;
- if (x=='T') return 'A' ;
+ if (x == 'A')
+ return 'T';
+ if (x == 'C')
+ return 'G';
+ if (x == 'G')
+ return 'C';
+ if (x == 'T')
+ return 'A';
- return x ;
+ return x;
}
-void mkupper(char *sx)
+void
+mkupper (char *sx)
{
- int len, k ;
-
- len = strlen(sx) ;
- for (k=0; k<len; ++k) {
- sx[k] = toupper(sx[k]) ;
- }
+ int len, k;
+
+ len = strlen (sx);
+ for (k = 0; k < len; ++k)
+ {
+ sx[k] = toupper(sx[k]);
+ }
}
-void mklower(char *sx)
+void
+mklower (char *sx)
{
- int len, k ;
-
- len = strlen(sx) ;
- for (k=0; k<len; ++k) {
- sx[k] = tolower(sx[k]) ;
- }
-}
+ int len, k;
+ len = strlen (sx);
+ for (k = 0; k < len; ++k)
+ {
+ sx[k] = tolower(sx[k]);
+ }
+}
-char *strstrx(char *s1, char *s2)
+char *
+strstrx (char *s1, char *s2)
// like strstr but case insensitive
// see also strcasestr
{
- char *ss1, *ss2, *spt ;
-
- ss1 = strdup(s1) ;
- ss2 = strdup(s2) ;
+ char *ss1, *ss2, *spt;
+ ss1 = strdup (s1);
+ ss2 = strdup (s2);
- mkupper(ss1) ;
- mkupper(ss2) ;
+ mkupper (ss1);
+ mkupper (ss2);
- spt = strstr(ss1, ss2) ;
- if (spt != NULL) {
- spt = s1 + (spt - ss1) ;
- }
+ spt = strstr (ss1, ss2);
+ if (spt != NULL)
+ {
+ spt = s1 + (spt - ss1);
+ }
- freestring(&ss1) ;
- freestring(&ss2) ;
+ freestring (&ss1);
+ freestring (&ss2);
- return spt ;
+ return spt;
}
-
-int
-getjjnames(char ***pnames, int **jj, int maxrow, int numcol, char *fname)
+int
+getjjnames (char ***pnames, int **jj, int maxrow, int numcol, char *fname)
{
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *sx ;
- int nsplit, i, j, num=0, maxff, numcolp ;
- FILE *fff ;
- int nbad = 0 ;
- char **names ;
-
- names = *pnames ;
- if (fname == NULL) fff = stdin ;
- else {
- openit(fname, &fff, "r") ;
- }
- numcolp = numcol + 1 ;
- maxff = MAX(MAXFF, numcolp) ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- names[num] = strdup(sx) ;
- if (nsplit<numcolp) {
- ++nbad ;
- if (nbad<10) printf("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol, line) ;
- continue ;
- }
- if (num>=maxrow) fatalx("too much data\n") ;
- for (i=0; i<numcol; i++) {
- jj[i][num] = atoi(spt[i+1]) ;
- }
- freeup(spt, nsplit) ;
- ++num ;
- }
- if (fname != NULL) fclose(fff) ;
- return num ;
+ char line[MAXSTR];
+ char *spt[MAXFF];
+ char *sx;
+ int nsplit, i, j, num = 0, maxff, numcolp;
+ FILE *fff;
+ int nbad = 0;
+ char **names;
+
+ names = *pnames;
+ if (fname == NULL)
+ fff = stdin;
+ else
+ {
+ openit (fname, &fff, "r");
+ }
+ numcolp = numcol + 1;
+ maxff = MAX(MAXFF, numcolp);
+
+ while (fgets (line, MAXSTR, fff) != NULL)
+ {
+ nsplit = splitup (line, spt, maxff);
+ if (nsplit == 0)
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ sx = spt[0];
+ if (sx[0] == '#')
+ {
+ freeup (spt, nsplit);
+ continue;
+ }
+ names[num] = strdup (sx);
+ if (nsplit < numcolp)
+ {
+ ++nbad;
+ if (nbad < 10)
+ printf ("+++ bad line: nsplit: %d numcol: %d\n%s\n", nsplit, numcol,
+ line);
+ continue;
+ }
+ if (num >= maxrow)
+ fatalx ("too much data\n");
+ for (i = 0; i < numcol; i++)
+ {
+ jj[i][num] = atoi (spt[i + 1]);
+ }
+ freeup (spt, nsplit);
+ ++num;
+ }
+ if (fname != NULL)
+ fclose (fff);
+ return num;
}
-int isiub(char iub)
+int
+isiub (char iub)
{
- char ss[5] ;
- int t ;
+ char ss[5];
+ int t;
- t = iubdekode(ss, iub) ;
- if (t==0) return NO ;
- return YES ;
+ t = iubdekode (ss, iub);
+ if (t == 0)
+ return NO;
+ return YES;
}
-int isiub2(char iub)
+int
+isiub2 (char iub)
{
// base or het iub should be upper case
- char ss[5] ;
- int t ;
+ char ss[5];
+ int t;
- t = iubdekode(ss, iub) ;
- if (t==1) return YES ;
- if (t==2) return YES ;
- return NO ;
+ t = iubdekode (ss, iub);
+ if (t == 1)
+ return YES;
+ if (t == 2)
+ return YES;
+ return NO;
}
-int iubdekode(char *aa, char iub)
+int
+iubdekode (char *aa, char iub)
// a should be 5 long
-{
-
- char a[5] ;
-
- switch (iub) {
-
- case 'A':
- strcpy(a,"A") ;
- break ;
- case 'C':
- strcpy(a,"C") ;
- break ;
- case 'G':
- strcpy(a,"G") ;
- break ;
- case 'T':
- strcpy(a,"T") ;
- break ;
- case 'M':
- strcpy(a,"AC") ;
- break ;
- case 'R':
- strcpy(a,"AG") ;
- break ;
- case 'W':
- strcpy(a,"AT") ;
- break ;
- case 'S':
- strcpy(a,"CG") ;
- break ;
- case 'Y':
- strcpy(a,"CT") ;
- break ;
- case 'K':
- strcpy(a,"GT") ;
- break ;
- case 'V':
- strcpy(a,"ACG") ;
- break ;
- case 'H':
- strcpy(a,"ACT") ;
- break ;
- case 'D':
- strcpy(a,"AGT") ;
- break ;
- case 'B':
- strcpy(a,"CGT") ;
- break ;
- case 'X':
- strcpy(a,"ACGT") ;
- break ;
- case 'N':
- strcpy(a,"ACGT") ;
- break ;
-
- default:
- a[0] = CNULL ;
- }
- if (aa != NULL) strcpy(aa, a) ;
- return strlen(a) ;
-}
-int iubcbases(char *cbases, char iub)
+{
+
+ char a[5];
+
+ switch (iub)
+ {
+
+ case 'A':
+ strcpy (a, "A");
+ break;
+ case 'C':
+ strcpy (a, "C");
+ break;
+ case 'G':
+ strcpy (a, "G");
+ break;
+ case 'T':
+ strcpy (a, "T");
+ break;
+ case 'M':
+ strcpy (a, "AC");
+ break;
+ case 'R':
+ strcpy (a, "AG");
+ break;
+ case 'W':
+ strcpy (a, "AT");
+ break;
+ case 'S':
+ strcpy (a, "CG");
+ break;
+ case 'Y':
+ strcpy (a, "CT");
+ break;
+ case 'K':
+ strcpy (a, "GT");
+ break;
+ case 'V':
+ strcpy (a, "ACG");
+ break;
+ case 'H':
+ strcpy (a, "ACT");
+ break;
+ case 'D':
+ strcpy (a, "AGT");
+ break;
+ case 'B':
+ strcpy (a, "CGT");
+ break;
+ case 'X':
+ strcpy (a, "ACGT");
+ break;
+ case 'N':
+ strcpy (a, "ACGT");
+ break;
+
+ default:
+ a[0] = CNULL;
+ }
+ if (aa != NULL)
+ strcpy (aa, a);
+ return strlen (a);
+}
+int
+iubcbases (char *cbases, char iub)
// crack iub into 2 bases (which may agree)
// return number of bases (1 or 2) or -1.
{
- char uu[5] ;
- int nuu ;
+ char uu[5];
+ int nuu;
- nuu = iubdekode(uu, iub) ;
- if (nuu<1) return -1 ;
- if (nuu>2) return -1 ;
- if (nuu==1) uu[1] = uu[0] ;
+ nuu = iubdekode (uu, iub);
+ if (nuu < 1)
+ return -1;
+ if (nuu > 2)
+ return -1;
+ if (nuu == 1)
+ uu[1] = uu[0];
- cbases[0] = uu[0] ;
- cbases[1] = uu[1] ;
+ cbases[0] = uu[0];
+ cbases[1] = uu[1];
- return nuu ;
+ return nuu;
}
-int ishet(char c)
+int
+ishet (char c)
{
- char aa[5] ;
- int n ;
+ char aa[5];
+ int n;
- n = iubdekode(aa, c) ;
- if (n==2) return YES ;
- return NO ;
+ n = iubdekode (aa, c);
+ if (n == 2)
+ return YES;
+ return NO;
}
-char *lastff(char *sss)
+char *
+lastff (char *sss)
{
- char *sx ;
- sx = strrchr(sss, '/') ;
- if (sx == NULL) return sss ;
- return sx+1 ;
+ char *sx;
+ sx = strrchr (sss, '/');
+ if (sx == NULL)
+ return sss;
+ return sx + 1;
}
-int char2int(char cc)
+int
+char2int (char cc)
{
- int x ;
- x = (int) (cc - '0') ;
- return x ;
+ int x;
+ x = (int) (cc - '0');
+ return x;
}
-char int2char(int x)
+char
+int2char (int x)
{
- char c ;
- c = (char) ('0' + x) ;
+ char c;
+ c = (char) ('0' + x);
}
-void chomp(char *cc)
+void
+chomp (char *cc)
{
- int len ;
- len = strlen(cc) ;
+ int len;
+ len = strlen (cc);
- if (len==0) return ;
- if (cc[len-1] == CNL) cc[len-1] = CNULL ;
+ if (len == 0)
+ return;
+ if (cc[len - 1] == CNL)
+ cc[len - 1] = CNULL;
}
-int numcmatch(char *cc, int len, char c)
+int
+numcmatch (char *cc, int len, char c)
{
- int k, t = 0 ;
+ int k, t = 0;
- for (k=0; k<len; ++k) {
- if (cc[k] == c) ++t ;
- }
+ for (k = 0; k < len; ++k)
+ {
+ if (cc[k] == c)
+ ++t;
+ }
- return t ;
+ return t;
}
-int numcnomatch(char *cc, int len, char c)
+int
+numcnomatch (char *cc, int len, char c)
{
- int k, t = 0 ;
+ int k, t = 0;
- for (k=0; k<len; ++k) {
- if (cc[k] != c) ++t ;
- }
+ for (k = 0; k < len; ++k)
+ {
+ if (cc[k] != c)
+ ++t;
+ }
- return t ;
+ return t;
}
diff --git a/src/nicksrc/twtable.c b/src/nicksrc/twtable.c
new file mode 100644
index 0000000..5a96fe5
--- /dev/null
+++ b/src/nicksrc/twtable.c
@@ -0,0 +1,94 @@
+/**
+
+ * @file twtable.c
+
+ * @brief Tracy-Widom distribution
+
+ */
+
+const double TWXVAL[] =
+ { -8.0, -7.9, -7.8, -7.7, -7.6, -7.5, -7.4, -7.3, -7.2, -7.1, -7.0, -6.9,
+ -6.8, -6.7, -6.6, -6.5, -6.4, -6.3, -6.2, -6.1, -6.0, -5.9, -5.8, -5.7,
+ -5.6, -5.5, -5.4, -5.3, -5.2, -5.1, -5.0, -4.9, -4.8, -4.7, -4.6, -4.5,
+ -4.4, -4.3, -4.2, -4.1, -4.0, -3.9, -3.8, -3.7, -3.6, -3.5, -3.4, -3.3,
+ -3.2, -3.1, -3.0, -2.9, -2.8, -2.7, -2.6, -2.5, -2.4, -2.3, -2.2, -2.1,
+ -2.0, -1.9, -1.8, -1.7, -1.6, -1.5, -1.4, -1.3, -1.2, -1.1, -1.0, -0.9,
+ -0.8, -0.7, -0.6, -0.5, -0.4, -0.3, -0.2, -0.1, 0.0, 0.1, 0.2, 0.3, 0.4,
+ 0.5, 0.6, 0.7, 0.8, 0.9, 1.0, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9,
+ 2.0, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 2.9, 3.0, 3.1, 3.2, 3.3, 3.4,
+ 3.5, 3.6, 3.7, 3.8, 3.9, 4.0, 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 4.9,
+ 5.0, 5.1, 5.2, 5.3, 5.4, 5.5, 5.6, 5.7, 5.8, 5.9, 6.0, 6.1, 6.2, 6.3, 6.4,
+ 6.5, 6.6, 6.7, 6.8, 6.9, 7.0, 7.1, 7.2, 7.3, 7.4, 7.5, 7.6, 7.7, 7.8, 7.9,
+ 8.0 };
+
+const double TWXTAIL[] =
+ { 1.000000000, 1.000000000, 1.000000000, 1.000000000, 1.000000000,
+ 1.000000000, 1.000000000, 0.999999999, 0.999999999, 0.999999997,
+ 0.999999995, 0.999999989, 0.999999978, 0.999999958, 0.999999920,
+ 0.999999849, 0.999999723, 0.999999498, 0.999999105, 0.999998431,
+ 0.999997293, 0.999995401, 0.999992309, 0.999987331, 0.999979441,
+ 0.999967125, 0.999948187, 0.999919496, 0.999876655, 0.999813597,
+ 0.999722082, 0.999591101, 0.999406175, 0.999148569, 0.998794427,
+ 0.998313849, 0.997669962, 0.996818016, 0.995704571, 0.994266851,
+ 0.992432322, 0.990118582, 0.987233631, 0.983676579, 0.979338843,
+ 0.974105853, 0.967859270, 0.960479677, 0.951849687, 0.941857369,
+ 0.930399881, 0.917387157, 0.902745495, 0.886420892, 0.868381957,
+ 0.848622271, 0.827162053, 0.804049066, 0.779358684, 0.753193114,
+ 0.725679802, 0.696969061, 0.667231036, 0.636652122, 0.605430961,
+ 0.573774198, 0.541892124, 0.509994383, 0.478285870, 0.446962951,
+ 0.416210105, 0.386197065, 0.357076521, 0.328982392, 0.302028689,
+ 0.276308949, 0.251896179, 0.228843301, 0.207183986, 0.186933854,
+ 0.168091934, 0.150642330, 0.134556018, 0.119792709, 0.106302721,
+ 0.094028817, 0.082907953, 0.072872924, 0.063853860, 0.055779577,
+ 0.048578763, 0.042180992, 0.036517582, 0.031522284, 0.027131832,
+ 0.023286351, 0.019929640, 0.017009350, 0.014477062, 0.012288293,
+ 0.010402429, 0.008782605, 0.007395547, 0.006211384, 0.005203434,
+ 0.004347977, 0.003624031, 0.003013114, 0.002499018, 0.002067590,
+ 0.001706520, 0.001405143, 0.001154255, 0.000945945, 0.000773431,
+ 0.000630927, 0.000513508, 0.000416999, 0.000337871, 0.000273152,
+ 0.000220344, 0.000177359, 0.000142452, 0.000114170, 0.000091308,
+ 0.000072871, 0.000058035, 0.000046124, 0.000036582, 0.000028955,
+ 0.000022872, 0.000018030, 0.000014185, 0.000011138, 0.000008728,
+ 0.000006826, 0.000005328, 0.000004151, 0.000003228, 0.000002505,
+ 0.000001941, 0.000001501, 0.000001158, 0.000000892, 0.000000686,
+ 0.000000527, 0.000000403, 0.000000308, 0.000000235, 0.000000179,
+ 0.000000136, 0.000000104, 0.000000079, 0.000000059, 0.000000045,
+ 0.000000034, 0.000000025, 0.000000019, 0.000000014, 0.000000011,
+ 0.000000008 };
+
+const double TWXPDF[] =
+ { 0.000000000, 0.000000000, 0.000000000, 0.000000000, 0.000000000,
+ 0.000000001, 0.000000002, 0.000000005, 0.000000010, 0.000000019,
+ 0.000000039, 0.000000076, 0.000000146, 0.000000276, 0.000000511,
+ 0.000000932, 0.000001670, 0.000002942, 0.000005097, 0.000008683,
+ 0.000014554, 0.000024005, 0.000038969, 0.000062279, 0.000098012,
+ 0.000151923, 0.000231995, 0.000349097, 0.000517756, 0.000757035,
+ 0.001091485, 0.001552137, 0.002177466, 0.003014256, 0.004118267,
+ 0.005554591, 0.007397591, 0.009730295, 0.012643159, 0.016232112,
+ 0.020595851, 0.025832397, 0.032034971, 0.039287325, 0.047658716,
+ 0.057198759, 0.067932445, 0.079855636, 0.092931337, 0.107087044,
+ 0.122213418, 0.138164458, 0.154759279, 0.171785501, 0.189004169,
+ 0.206156009, 0.222968755, 0.239165233, 0.254471803, 0.268626779,
+ 0.281388431, 0.292542221, 0.301906945, 0.309339558, 0.314738516,
+ 0.318045543, 0.319245849, 0.318366852, 0.315475570, 0.310674866,
+ 0.304098784, 0.295907232, 0.286280263, 0.275412215, 0.263505933,
+ 0.250767272, 0.237400053, 0.223601597, 0.209558915, 0.195445624,
+ 0.181419571, 0.167621190, 0.154172511, 0.141176787, 0.128718659,
+ 0.116864772, 0.105664756, 0.095152500, 0.085347620, 0.076257058,
+ 0.067876743, 0.060193257, 0.053185457, 0.046826015, 0.041082856,
+ 0.035920459, 0.031301023, 0.027185487, 0.023534398, 0.020308645,
+ 0.017470054, 0.014981856, 0.012809046, 0.010918644, 0.009279861,
+ 0.007864200, 0.006645482, 0.005599836, 0.004705636, 0.003943413,
+ 0.003295741, 0.002747112, 0.002283795, 0.001893694, 0.001566204,
+ 0.001292071, 0.001063253, 0.000872795, 0.000714702, 0.000583831,
+ 0.000475784, 0.000386816, 0.000313749, 0.000253894, 0.000204987,
+ 0.000165125, 0.000132716, 0.000106431, 0.000085163, 0.000067996,
+ 0.000054172, 0.000043066, 0.000034164, 0.000027045, 0.000021365,
+ 0.000016843, 0.000013250, 0.000010403, 0.000008151, 0.000006374,
+ 0.000004974, 0.000003874, 0.000003011, 0.000002336, 0.000001809,
+ 0.000001398, 0.000001078, 0.000000830, 0.000000638, 0.000000489,
+ 0.000000375, 0.000000286, 0.000000218, 0.000000166, 0.000000126,
+ 0.000000096, 0.000000073, 0.000000055, 0.000000041, 0.000000031,
+ 0.000000023 };
+
+const int TWTABSIZE = 161;
diff --git a/src/nicksrc/vsubs.c b/src/nicksrc/vsubs.c
index dc423f8..453d366 100644
--- a/src/nicksrc/vsubs.c
+++ b/src/nicksrc/vsubs.c
@@ -9,1856 +9,2144 @@
tiny routines BLAS?
a small library to do simple arithmetic
on 1D vectors with no skips
-*/
-void
-vsp(double *a, double *b, double c, int n)
-{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] + c ;
-}
-void
-vst(double *a, double *b, double c, int n)
+ */
+void
+vsp (double *a, double *b, double c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] * c ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] + c;
}
-void
-vvt(double *a, double *b, double *c, int n)
+void
+vst (double *a, double *b, double c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] * c[i] ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] * c;
}
-void
-vvp(double *a, double *b, double *c, int n)
+void
+vvt (double *a, double *b, double *c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] + c[i] ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] * c[i];
}
-void
-vvm(double *a, double *b, double *c, int n)
+void
+vvp (double *a, double *b, double *c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] - c[i] ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] + c[i];
}
-void
-vvd(double *a, double *b, double *c, int n)
+void
+vvm (double *a, double *b, double *c, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- if (c[i] == 0.0)
- fatalx("(vvd): zero value in denominator\n") ;
- a[i] = b[i] / c[i] ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] - c[i];
}
-void
-vsqrt(double *a, double *b, int n)
-{
- int i ;
- for (i=0; i<n; i++) {
- if (b[i]<0.0)
- fatalx("(vsqrt): negative value %g\n",b[i]) ;
- if (b[i] == 0.0) {
- a[i] = 0.0 ;
- continue ;
+void
+vvd (double *a, double *b, double *c, int n)
+{
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (c[i] == 0.0)
+ fatalx ("(vvd): zero value in denominator\n");
+ a[i] = b[i] / c[i];
}
- a[i] = sqrt(b[i]) ;
- }
}
-void
-vinvert(double *a, double *b, int n)
-{
- int i ;
- for (i=0; i<n; i++) {
- if (b[i] == 0.0)
- fatalx("(vinvert): zero value\n") ;
- a[i] = 1.0 / b[i] ;
- }
+void
+vsqrt (double *a, double *b, int n)
+{
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (b[i] < 0.0)
+ fatalx ("(vsqrt): negative value %g\n", b[i]);
+ if (b[i] == 0.0)
+ {
+ a[i] = 0.0;
+ continue;
+ }
+ a[i] = sqrt (b[i]);
+ }
}
-void
-vabs(double *a, double *b, int n)
-{
- int i ;
- for (i=0; i<n; i++) {
- a[i] = fabs(b[i]) ;
- }
+void
+vinvert (double *a, double *b, int n)
+{
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (b[i] == 0.0)
+ fatalx ("(vinvert): zero value\n");
+ a[i] = 1.0 / b[i];
+ }
}
-void
-vlog(double *a, double *b, int n)
+void
+vabs (double *a, double *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- if (b[i]<=0.0)
- fatalx("(vlog): negative or zero value %g\n",b[i]) ;
- a[i] = log(b[i]) ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ a[i] = fabs (b[i]);
+ }
}
-void
-vlog2(double *a, double *b, int n)
-{
- int i ;
- for (i=0; i<n; i++) {
- if (b[i]<=0.0)
- fatalx("(vlog2): negative or zero value %g\n",b[i]) ;
- a[i] = NPlog2(b[i]) ;
- }
+void
+vlog (double *a, double *b, int n)
+{
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (b[i] <= 0.0)
+ fatalx ("(vlog): negative or zero value %g\n", b[i]);
+ a[i] = log (b[i]);
+ }
+}
+void
+vlog2 (double *a, double *b, int n)
+{
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (b[i] <= 0.0)
+ fatalx ("(vlog2): negative or zero value %g\n", b[i]);
+ a[i] = NPlog2 (b[i]);
+ }
}
-void
-vexp(double *a, double *b, int n)
+void
+vexp (double *a, double *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- a[i] = exp(b[i]) ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ a[i] = exp (b[i]);
+ }
}
-void
-vclear(double *a, double c, int n)
+void
+vclear (double *a, double c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = c ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = c;
}
-void
-vzero(double *a, int n)
+void
+vzero (double *a, int n)
{
- vclear(a, 0.0, n) ;
+ vclear (a, 0.0, n);
}
-void
-cpzero(char **a, int n)
+void
+cpzero (char **a, int n)
{
- int i ;
- for (i=0; i<n; ++i) {
- a[i] = NULL ;
- }
+ int i;
+ for (i = 0; i < n; ++i)
+ {
+ a[i] = NULL;
+ }
}
-void
-cclear(unsigned char *a, unsigned char c, long n)
+void
+cclear (unsigned char *a, unsigned char c, long n)
/**
be careful nothing done about NULL at end
-*/
+ */
{
- long i ;
- for (i=0; i<n; i++) {
- a[i] = c ;
- }
+ long i;
+ for (i = 0; i < n; i++)
+ {
+ a[i] = c;
+ }
}
-void
-ivvp(int *a, int *b, int *c, int n)
+void
+ivvp (int *a, int *b, int *c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] + c[i] ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] + c[i];
}
-void
-ivvm(int *a, int *b, int *c, int n)
+void
+ivvm (int *a, int *b, int *c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] - c[i] ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] - c[i];
}
-void
-ivsp(int *a, int *b, int c, int n)
+void
+ivsp (int *a, int *b, int c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] + c ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] + c;
}
-void
-ivst(int *a, int *b, int c, int n)
+void
+ivst (int *a, int *b, int c, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = b[i] * c ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = b[i] * c;
}
-void
-ivclear(int *a, int c, long n)
+void
+ivclear (int *a, int c, long n)
{
- long i ;
- for (i=0; i<n; i++)
- a[i] = c ;
+ long i;
+ for (i = 0; i < n; i++)
+ a[i] = c;
}
-void
-lvclear(long *a, long c, long n)
+void
+lvclear (long *a, long c, long n)
{
- long i ;
- for (i=0; i<n; i++)
- a[i] = c ;
+ long i;
+ for (i = 0; i < n; i++)
+ a[i] = c;
}
void
-ivzero(int *a, int n)
+ivzero (int *a, int n)
{
- ivclear(a, 0, n) ;
+ ivclear (a, 0, n);
}
-double clip(double x, double lo, double hi)
+double
+clip (double x, double lo, double hi)
/* clip off values to range [lo,hi] */
{
- if (x<lo) return lo ;
- if (x>hi) return hi ;
- return x ;
+ if (x < lo)
+ return lo;
+ if (x > hi)
+ return hi;
+ return x;
}
-void
-ivclip(int *a, int *b,int loval, int hival,int n)
+void
+ivclip (int *a, int *b, int loval, int hival, int n)
{
-/* clip off values to range [loval,hival] */
- int i ;
- int t ;
+ /* clip off values to range [loval,hival] */
+ int i;
+ int t;
- for (i=0; i<n; i++) {
- t = MAX(b[i],loval) ;
- a[i] = MIN(t,hival) ;
- }
+ for (i = 0; i < n; i++)
+ {
+ t = MAX(b[i], loval);
+ a[i] = MIN(t, hival);
+ }
}
-void
-vclip(double *a, double *b,double loval, double hival,int n)
+void
+vclip (double *a, double *b, double loval, double hival, int n)
{
-/* clip off values to range [loval,hival] */
- int i ;
- double t ;
+ /* clip off values to range [loval,hival] */
+ int i;
+ double t;
- for (i=0; i<n; i++) {
- t = MAX(b[i],loval) ;
- a[i] = MIN(t,hival) ;
- }
+ for (i = 0; i < n; i++)
+ {
+ t = MAX(b[i], loval);
+ a[i] = MIN(t, hival);
+ }
}
-void vmaxmin(double *a, int n, double *max, double *min)
+void
+vmaxmin (double *a, int n, double *max, double *min)
{
- int i ;
- double tmax, tmin ;
+ int i;
+ double tmax, tmin;
- tmax = tmin = a[0] ;
- for (i=1; i<n; i++) {
- tmax = MAX(tmax, a[i]) ;
- tmin = MIN(tmin, a[i]) ;
+ tmax = tmin = a[0];
+ for (i = 1; i < n; i++)
+ {
+ tmax = MAX(tmax, a[i]);
+ tmin = MIN(tmin, a[i]);
}
- if (max != NULL) *max = tmax ;
- if (min != NULL) *min = tmin ;
+ if (max != NULL)
+ *max = tmax;
+ if (min != NULL)
+ *min = tmin;
}
-void vlmaxmin(double *a, int n, int *pmax, int *pmin)
+void
+vlmaxmin (double *a, int n, int *pmax, int *pmin)
/**
return location
-*/
+ */
{
- int i ;
- double tmax, tmin ;
- double lmax, lmin ;
+ int i;
+ double tmax, tmin;
+ double lmax, lmin;
- tmax = tmin = a[0] ;
- lmax = lmin = 0 ;
- for (i=1; i<n; i++) {
- if (a[i]>tmax) {
- tmax = a[i] ;
- lmax=i ;
- }
- if (a[i]<tmin) {
- tmin = a[i] ;
- lmin=i ;
- }
+ tmax = tmin = a[0];
+ lmax = lmin = 0;
+ for (i = 1; i < n; i++)
+ {
+ if (a[i] > tmax)
+ {
+ tmax = a[i];
+ lmax = i;
+ }
+ if (a[i] < tmin)
+ {
+ tmin = a[i];
+ lmin = i;
+ }
}
- if (pmax != NULL) *pmax = lmax ;
- if (pmin != NULL) *pmin = lmin ;
+ if (pmax != NULL)
+ *pmax = lmax;
+ if (pmin != NULL)
+ *pmin = lmin;
}
-void ivmaxmin(int *a, int n, int *max, int *min)
+void
+ivmaxmin (int *a, int n, int *max, int *min)
{
- int i ;
- int tmax, tmin ;
+ int i;
+ int tmax, tmin;
- tmax = tmin = a[0] ;
- for (i=1; i<n; i++) {
- tmax = MAX(tmax, a[i]) ;
- tmin = MIN(tmin, a[i]) ;
+ tmax = tmin = a[0];
+ for (i = 1; i < n; i++)
+ {
+ tmax = MAX(tmax, a[i]);
+ tmin = MIN(tmin, a[i]);
}
- if (max != NULL) *max = tmax ;
- if (min != NULL) *min = tmin ;
+ if (max != NULL)
+ *max = tmax;
+ if (min != NULL)
+ *min = tmin;
}
-int minivec(int *a, int n)
+int
+minivec (int *a, int n)
{
- int t ;
+ int t;
- ivmaxmin(a, n, NULL, &t) ;
- return t ;
+ ivmaxmin (a, n, NULL, &t);
+ return t;
}
-int maxivec(int *a, int n)
+int
+maxivec (int *a, int n)
{
- int t ;
+ int t;
- ivmaxmin(a, n, &t, NULL) ;
- return t ;
+ ivmaxmin (a, n, &t, NULL);
+ return t;
}
-void ivlmaxmin(int *a, int n, int *pmax, int *pmin)
+void
+ivlmaxmin (int *a, int n, int *pmax, int *pmin)
/**
return location
-*/
+ */
{
- int i ;
- int tmax, tmin ;
- int lmax, lmin ;
+ int i;
+ int tmax, tmin;
+ int lmax, lmin;
- tmax = tmin = a[0] ;
- lmax = lmin = 0 ;
- for (i=1; i<n; i++) {
- if (a[i]>tmax) {
- tmax = a[i] ;
- lmax=i ;
- }
- if (a[i]<tmin) {
- tmin = a[i] ;
- lmin=i ;
- }
+ tmax = tmin = a[0];
+ lmax = lmin = 0;
+ for (i = 1; i < n; i++)
+ {
+ if (a[i] > tmax)
+ {
+ tmax = a[i];
+ lmax = i;
+ }
+ if (a[i] < tmin)
+ {
+ tmin = a[i];
+ lmin = i;
+ }
}
- if (pmax != NULL) *pmax = lmax ;
- if (pmin != NULL) *pmin = lmin ;
+ if (pmax != NULL)
+ *pmax = lmax;
+ if (pmin != NULL)
+ *pmin = lmin;
}
-double
-vdot(double *a, double *b, int n)
+double
+vdot (double *a, double *b, int n)
{
- int i;
- double ans=0.0 ;
- for (i=0; i<n; i++)
- ans += a[i]*b[i] ;
+ int i;
+ double ans = 0.0;
+ for (i = 0; i < n; i++)
+ ans += a[i] * b[i];
- return ans ;
+ return ans;
}
-double corr(double *a, double *b, int n)
+double
+corr (double *a, double *b, int n)
{
- double v12, v11, v22, y1, y2, y ;
- double *aa, *bb ;
- ZALLOC(aa, n, double) ;
- ZALLOC(bb, n, double) ;
- y1 = asum(a,n)/ (double) n ;
- y2 = asum(b,n)/ (double) n ;
+ double v12, v11, v22, y1, y2, y;
+ double *aa, *bb;
+ ZALLOC(aa, n, double);
+ ZALLOC(bb, n, double);
+ y1 = asum (a, n) / (double) n;
+ y2 = asum (b, n) / (double) n;
- vsp(aa, a, -y1, n) ;
- vsp(bb, b, -y2, n) ;
+ vsp (aa, a, -y1, n);
+ vsp (bb, b, -y2, n);
- v12 = vdot(aa, bb, n) ;
- v11 = asum2(aa, n) ;
- v22 = asum2(bb, n) ;
+ v12 = vdot (aa, bb, n);
+ v11 = asum2 (aa, n);
+ v22 = asum2 (bb, n);
- y = v11*v22 ;
- if (y==0.0) fatalx("(corr) constant vector\n") ;
+ y = v11 * v22;
+ if (y == 0.0)
+ fatalx ("(corr) constant vector\n");
-
- free(aa) ; free(bb) ;
- return (v12/sqrt(y)) ;
+ free (aa);
+ free (bb);
+ return (v12 / sqrt (y));
}
-double corrx(double *a, double *b, int n)
+double
+corrx (double *a, double *b, int n)
// like corr but constant vec returns 0
{
- double v12, v11, v22, y1, y2, y ;
- double *aa, *bb ;
+ double v12, v11, v22, y1, y2, y;
+ double *aa, *bb;
- ZALLOC(aa, n, double) ;
- ZALLOC(bb, n, double) ;
- y1 = asum(a,n)/ (double) n ;
- y2 = asum(b,n)/ (double) n ;
+ ZALLOC(aa, n, double);
+ ZALLOC(bb, n, double);
+ y1 = asum (a, n) / (double) n;
+ y2 = asum (b, n) / (double) n;
- vsp(aa, a, -y1, n) ;
- vsp(bb, b, -y2, n) ;
+ vsp (aa, a, -y1, n);
+ vsp (bb, b, -y2, n);
- v12 = vdot(aa, bb, n) ;
- v11 = asum2(aa, n) ;
- v22 = asum2(bb, n) ;
+ v12 = vdot (aa, bb, n);
+ v11 = asum2 (aa, n);
+ v22 = asum2 (bb, n);
- free(aa) ; free(bb) ;
+ free (aa);
+ free (bb);
- y = v11*v22 ;
- y += 1.0e-12 ;
+ y = v11 * v22;
+ y += 1.0e-12;
- return (v12/sqrt(y)) ;
+ return (v12 / sqrt (y));
}
-
-double variance(double *a, int n)
+double
+variance (double *a, int n)
{
- double *aa ;
- double y1, y2 ;
+ double *aa;
+ double y1, y2;
- ZALLOC(aa, n, double) ;
- y1 = asum(a,n)/ (double) n ;
- vsp(aa, a, -y1, n) ;
+ ZALLOC(aa, n, double);
+ y1 = asum (a, n) / (double) n;
+ vsp (aa, a, -y1, n);
- y2 = asum(aa,n)/ (double) n ;
+ y2 = asum (aa, n) / (double) n;
- free(aa) ;
- return y2 ;
+ free (aa);
+ return y2;
}
-void
-getdiag(double *a, double *b, int n)
+void
+getdiag (double *a, double *b, int n)
/* extract diagonal */
{
- int i, k ;
+ int i, k;
- for (i=0; i<n; i++) {
- k = i*n+i ;
- a[i] = b[k] ;
- }
+ for (i = 0; i < n; i++)
+ {
+ k = i * n + i;
+ a[i] = b[k];
+ }
}
-void
-setdiag(double *a, double *diag, int n)
+void
+setdiag (double *a, double *diag, int n)
/* set diagonal matrix */
{
- int i, k ;
+ int i, k;
- vzero(a, n*n) ;
- for (i=0; i<n; i++) {
- k = i*n+i ;
- a[k] = diag[i] ;
- }
+ vzero (a, n * n);
+ for (i = 0; i < n; i++)
+ {
+ k = i * n + i;
+ a[k] = diag[i];
+ }
}
-
-void copyarr(double *a,double *b,int n)
+void
+copyarr (double *a, double *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- b[i] = a[i] ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ b[i] = a[i];
+ }
}
-void revarr(double *b,double *a,int n)
-{
- int i ;
- double *x ;
- ZALLOC(x, n, double) ;
- for (i=0; i<n; i++) {
- x[n-i-1] = a[i] ;
- }
- copyarr(x, b, n) ;
- free(x) ;
+void
+revarr (double *b, double *a, int n)
+{
+ int i;
+ double *x;
+ ZALLOC(x, n, double);
+ for (i = 0; i < n; i++)
+ {
+ x[n - i - 1] = a[i];
+ }
+ copyarr (x, b, n);
+ free (x);
}
-void revuiarr(unsigned int *b, unsigned int *a, int n)
-{
- int i ;
- unsigned int *x ;
- ZALLOC(x, n, unsigned int) ;
- for (i=0; i<n; i++) {
- x[n-i-1] = a[i] ;
- }
- for (i=0; i<n; i++) {
- b[i] = x[i] ;
- }
- free(x) ;
+void
+revuiarr (unsigned int *b, unsigned int *a, int n)
+{
+ int i;
+ unsigned int *x;
+ ZALLOC(x, n, unsigned int);
+ for (i = 0; i < n; i++)
+ {
+ x[n - i - 1] = a[i];
+ }
+ for (i = 0; i < n; i++)
+ {
+ b[i] = x[i];
+ }
+ free (x);
}
-void reviarr(int *b,int *a,int n)
-{
- int i ;
- int *x ;
- ZALLOC(x, n, int) ;
- for (i=0; i<n; i++) {
- x[n-i-1] = a[i] ;
- }
- copyiarr(x, b, n) ;
- free(x) ;
-
+void
+reviarr (int *b, int *a, int n)
+{
+ int i;
+ int *x;
+ ZALLOC(x, n, int);
+ for (i = 0; i < n; i++)
+ {
+ x[n - i - 1] = a[i];
+ }
+ copyiarr (x, b, n);
+ free (x);
+
}
-void copyiarr(int *a,int *b,int n)
+void
+copyiarr (int *a, int *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- b[i] = a[i] ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ b[i] = a[i];
+ }
}
-void copyiparr(int **a,int **b,int n)
+void
+copyiparr (int **a, int **b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- b[i] = a[i] ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ b[i] = a[i];
+ }
}
-void dpermute(double *a, int *ind, int len)
+void
+dpermute (double *a, int *ind, int len)
{
- int i , k ;
- double *rrr ;
+ int i, k;
+ double *rrr;
- ZALLOC(rrr, len, double) ;
+ ZALLOC(rrr, len, double);
- for (i=0; i<len; i++) {
- rrr[i] = a[i] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ rrr[i] = a[i];
+ }
- for (i=0; i<len; i++) {
- k = ind[i] ;
- a[i] = rrr[k] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ k = ind[i];
+ a[i] = rrr[k];
+ }
- free (rrr) ;
+ free (rrr);
}
-void ipermute(int *a, int *ind, int len)
+void
+ipermute (int *a, int *ind, int len)
{
- int i , k ;
- int *rrr ;
+ int i, k;
+ int *rrr;
- ZALLOC(rrr, len, int) ;
+ ZALLOC(rrr, len, int);
- copyiarr(a, rrr, len) ;
+ copyiarr (a, rrr, len);
- for (i=0; i<len; i++) {
- k = ind[i] ;
- a[i] = rrr[k] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ k = ind[i];
+ a[i] = rrr[k];
+ }
- free (rrr) ;
+ free (rrr);
}
-void dppermute(double **a, int *ind, int len)
+void
+dppermute (double **a, int *ind, int len)
{
- int i , k ;
- double **rrr ;
+ int i, k;
+ double **rrr;
- ZALLOC(rrr, len, double *) ;
+ ZALLOC(rrr, len, double *);
- for (i=0; i<len; i++) {
- rrr[i] = a[i] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ rrr[i] = a[i];
+ }
- for (i=0; i<len; i++) {
- k = ind[i] ;
- a[i] = rrr[k] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ k = ind[i];
+ a[i] = rrr[k];
+ }
- free (rrr) ;
+ free (rrr);
}
-void ippermute(int **a, int *ind, int len)
+void
+ippermute (int **a, int *ind, int len)
{
- int i , k ;
- int **rrr ;
+ int i, k;
+ int **rrr;
- ZALLOC(rrr, len, int *) ;
+ ZALLOC(rrr, len, int *);
- for (i=0; i<len; i++) {
- rrr[i] = a[i] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ rrr[i] = a[i];
+ }
- for (i=0; i<len; i++) {
- k = ind[i] ;
- a[i] = rrr[k] ;
- }
+ for (i = 0; i < len; i++)
+ {
+ k = ind[i];
+ a[i] = rrr[k];
+ }
- free (rrr) ;
+ free (rrr);
}
-double asum(double *a, int n)
+double
+asum (double *a, int n)
{
- int i;
- double ans=0.0 ;
- for (i=0; i<n; i++)
- ans += a[i] ;
+ int i;
+ double ans = 0.0;
+ for (i = 0; i < n; i++)
+ ans += a[i];
- return ans ;
+ return ans;
}
-int intsum(int *a, int n)
+int
+intsum (int *a, int n)
{
- int i;
- int ans=0 ;
- for (i=0; i<n; i++)
- ans += a[i] ;
+ int i;
+ int ans = 0;
+ for (i = 0; i < n; i++)
+ ans += a[i];
- return ans ;
+ return ans;
}
-long longsum(long *a, int n)
+long
+longsum (long *a, int n)
{
- int i;
- long ans=0 ;
- for (i=0; i<n; i++)
- ans += a[i] ;
+ int i;
+ long ans = 0;
+ for (i = 0; i < n; i++)
+ ans += a[i];
- return ans ;
+ return ans;
}
-int idot(int *a, int *b, int n)
+int
+idot (int *a, int *b, int n)
{
- int i;
- int ans=0.0 ;
- for (i=0; i<n; i++)
- ans += a[i]*b[i] ;
+ int i;
+ int ans = 0.0;
+ for (i = 0; i < n; i++)
+ ans += a[i] * b[i];
- return ans ;
+ return ans;
}
-int iprod(int *a, int n)
+int
+iprod (int *a, int n)
/* overflow not checked */
{
- int i;
- int ans=1 ;
- for (i=0; i<n; i++)
- ans *= a[i] ;
+ int i;
+ int ans = 1;
+ for (i = 0; i < n; i++)
+ ans *= a[i];
- return ans ;
+ return ans;
}
-
-double aprod(double *a, int n)
+double
+aprod (double *a, int n)
/* overflow not checked */
{
- int i;
- double ans=1.0 ;
- for (i=0; i<n; i++)
- ans *= a[i] ;
+ int i;
+ double ans = 1.0;
+ for (i = 0; i < n; i++)
+ ans *= a[i];
- return ans ;
+ return ans;
}
-double asum2(double *a, int n)
+double
+asum2 (double *a, int n)
{
- int i;
- double ans=0.0 ;
- for (i=0; i<n; i++)
- ans += a[i]*a[i] ;
+ int i;
+ double ans = 0.0;
+ for (i = 0; i < n; i++)
+ ans += a[i] * a[i];
- return ans ;
+ return ans;
}
-double trace(double *a, int n)
+double
+trace (double *a, int n)
{
- double *diags, t ;
- ZALLOC(diags,n,double) ;
- getdiag(diags,a,n) ; /* extract diagonal */
- t = asum(diags,n) ;
- free(diags) ;
- return t ;
+ double *diags, t;
+ ZALLOC(diags,n,double);
+ getdiag (diags, a, n); /* extract diagonal */
+ t = asum (diags, n);
+ free (diags);
+ return t;
}
-int nnint(double x)
+int
+nnint (double x)
{
- long int lrint(double x) ;
+ long int
+ lrint (double x);
// double round(double x) ;
- return (int) lrint(x) ;
+ return (int) lrint (x);
}
-void
-countcat(int *tags, int n,int *ncat,int nclass)
+void
+countcat (int *tags, int n, int *ncat, int nclass)
/* simple frequency count of integer array */
{
- int i, k;
- ivzero(ncat, nclass) ;
- for (i=0 ; i<n ; i++) {
- k = tags[i] ;
- if ( (k<0) || (k >= nclass))
- fatalx("(countcat) bounds error\n") ;
- ++ncat[k] ;
- }
+ int i, k;
+ ivzero (ncat, nclass);
+ for (i = 0; i < n; i++)
+ {
+ k = tags[i];
+ if ((k < 0) || (k >= nclass))
+ fatalx ("(countcat) bounds error\n");
+ ++ncat[k];
+ }
}
-void rowsum(double *a, double *rr, int n)
-{
- int i,j ;
- vclear(rr,0.0,n) ;
- for (i=0; i<n; i++) {
- for (j=0; j<n; j++) {
- rr[j] += a[i+j*n] ;
+void
+rowsum (double *a, double *rr, int n)
+{
+ int i, j;
+ vclear (rr, 0.0, n);
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ rr[j] += a[i + j * n];
+ }
}
- }
}
-void colsum(double *a, double *cc, int n)
-{
- int i,j ;
- vclear(cc,0.0,n) ;
- for (i=0; i<n; i++) {
- for (j=0; j<n; j++) {
- cc[i] += a[i+j*n] ;
+void
+colsum (double *a, double *cc, int n)
+{
+ int i, j;
+ vclear (cc, 0.0, n);
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ cc[i] += a[i + j * n];
+ }
}
- }
}
-void rrsum(double *a, double *rr, int m, int n)
-{
- int i,j ;
- vclear(rr,0.0,n) ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- rr[j] += a[i+j*m] ;
+void
+rrsum (double *a, double *rr, int m, int n)
+{
+ int i, j;
+ vclear (rr, 0.0, n);
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ rr[j] += a[i + j * m];
+ }
}
- }
}
-void ccsum(double *a, double *cc, int m, int n)
-{
- int i,j ;
- vclear(cc,0.0,m) ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- cc[i] += a[i+j*m] ;
+void
+ccsum (double *a, double *cc, int m, int n)
+{
+ int i, j;
+ vclear (cc, 0.0, m);
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ cc[i] += a[i + j * m];
+ }
}
- }
}
-void printmatfile(double *a, int m, int n, FILE *fff)
+void
+printmatfile (double *a, int m, int n, FILE *fff)
/**
print a matrix n wide m rows
-*/
+ */
{
- printmatwfile(a, m, n, 5, fff) ;
+ printmatwfile (a, m, n, 5, fff);
}
-void printmatwfile(double *a, int m, int n, int w, FILE *fff)
+void
+printmatwfile (double *a, int m, int n, int w, FILE *fff)
/**
print a matrix n wide m rows w to a row
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- fprintf(fff, "%9.3f ", a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- fprintf(fff, " ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fff, "%9.3f ", a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ fprintf (fff, " ...\n");
+ }
}
- fprintf(fff, "\n") ;
- }
+ fprintf (fff, "\n");
+ }
}
-void printmat(double *a, int m, int n)
+void
+printmat (double *a, int m, int n)
/**
print a matrix n wide m rows
-*/
+ */
{
- printmatw(a, m, n, 5) ;
+ printmatw (a, m, n, 5);
}
-void printmatw(double *a, int m, int n, int w)
+void
+printmatw (double *a, int m, int n, int w)
/**
print a matrix n wide m rows w to a row
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%9.3f ", a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%9.3f ", a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-void printmatl(double *a, int m, int n)
+void
+printmatl (double *a, int m, int n)
/**
print a matrix n wide m rows
-*/
+ */
{
- printmatwl(a, m, n, 5) ;
+ printmatwl (a, m, n, 5);
}
-void printmatwl(double *a, int m, int n, int w)
+void
+printmatwl (double *a, int m, int n, int w)
/**
print a matrix n wide m rows w to a row
15.9f format
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%15.9f ", a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%15.9f ", a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-void printmatwf(double *a, int m, int n, int w, char *format)
+void
+printmatwf (double *a, int m, int n, int w, char *format)
/**
print a matrix n wide m rows w to a row with format
no spacing introduced here. User must supply
-*/
+ */
{
- int i,j, jmod ;
- if (format == NULL) {
- printmatw(a, m, n, w) ;
- return ;
- }
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf(format, a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ int i, j, jmod;
+ if (format == NULL)
+ {
+ printmatw (a, m, n, w);
+ return;
+ }
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf (format, a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-
-void int2c(char *cc, int *b, int n)
+void
+int2c (char *cc, int *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- cc[i] = (char) b[i] ;
- }
- cc[n] = '\0' ;
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ cc[i] = (char) b[i];
+ }
+ cc[n] = '\0';
}
-void floatit(double *a, int *b, int n)
+void
+floatit (double *a, int *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- a[i] = (double) b[i] ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ a[i] = (double) b[i];
+ }
}
-void printimatwfile(int *a, int m, int n, int w, FILE *fff)
+void
+printimatwfile (int *a, int m, int n, int w, FILE *fff)
/**
print a matrix n wide m rows w to a row
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- fprintf(fff, "%5d ", a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- fprintf(fff, " ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fff, "%5d ", a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ fprintf (fff, " ...\n");
+ }
}
- fprintf(fff, "\n") ;
- }
+ fprintf (fff, "\n");
+ }
}
-void printimatw(int *a, int m, int n, int w)
+void
+printimatw (int *a, int m, int n, int w)
/**
print a matrix n wide m rows w to a row
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%5d ", a[i*n+j]) ;
- jmod = (j+1) % w ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%5d ", a[i * n + j]);
+ jmod = (j + 1) % w;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-void printimatx(int *a, int m, int n)
+void
+printimatx (int *a, int m, int n)
/**
print a matrix n wide m rows
no final new line
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%5d ", a[i*n+j]) ;
- jmod = (j+1) % 10 ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%5d ", a[i * n + j]);
+ jmod = (j + 1) % 10;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- }
+ }
}
-void printimatfile(int *a, int m, int n, FILE *fff)
+void
+printimatfile (int *a, int m, int n, FILE *fff)
/**
print a matrix n wide m rows
-*/
+ */
{
- printimatwfile(a, m, n, 10, fff) ;
+ printimatwfile (a, m, n, 10, fff);
}
-void printimat(int *a, int m, int n)
+void
+printimat (int *a, int m, int n)
/**
print a matrix n wide m rows
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%5d ", a[i*n+j]) ;
- jmod = (j+1) % 10 ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%5d ", a[i * n + j]);
+ jmod = (j + 1) % 10;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-void printimatlfile(int *a, int m, int n, FILE *fff)
+void
+printimatlfile (int *a, int m, int n, FILE *fff)
/**
print a matrix n wide m rows %10d format
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- fprintf(fff, "%10d ", a[i*n+j]) ;
- jmod = (j+1) % 10 ;
- if ((jmod == 0) && (j<(n-1))) {
- fprintf(fff, " ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ fprintf (fff, "%10d ", a[i * n + j]);
+ jmod = (j + 1) % 10;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ fprintf (fff, " ...\n");
+ }
}
- fprintf(fff, "\n") ;
- }
+ fprintf (fff, "\n");
+ }
}
-void printimatl(int *a, int m, int n)
+void
+printimatl (int *a, int m, int n)
/**
print a matrix n wide m rows %10d format
-*/
-{
- int i,j, jmod ;
- for (i=0; i<m; i++) {
- for (j=0; j<n; j++) {
- printf("%10d ", a[i*n+j]) ;
- jmod = (j+1) % 10 ;
- if ((jmod == 0) && (j<(n-1))) {
- printf(" ...\n") ;
- }
+ */
+{
+ int i, j, jmod;
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ printf ("%10d ", a[i * n + j]);
+ jmod = (j + 1) % 10;
+ if ((jmod == 0) && (j < (n - 1)))
+ {
+ printf (" ...\n");
+ }
}
- printf("\n") ;
- }
+ printf ("\n");
+ }
}
-void printstringf(char *ss, int w, FILE *fff)
-{
- char *sss ;
- char *sx ;
-
- ZALLOC(sss, w+1, char) ;
- cclear(sss, CNULL, w+1) ;
-
- sx = ss ;
- for (;;) {
- strncpy(sss, sx, w) ;
- if (strlen(sss) <= 0) break ;
- sx += w ;
- fprintf(fff, "%s\n", sss) ;
- }
+void
+printstringf (char *ss, int w, FILE *fff)
+{
+ char *sss;
+ char *sx;
+
+ ZALLOC(sss, w+1, char);
+ cclear (sss, CNULL, w + 1);
+
+ sx = ss;
+ for (;;)
+ {
+ strncpy (sss, sx, w);
+ if (strlen (sss) <= 0)
+ break;
+ sx += w;
+ fprintf (fff, "%s\n", sss);
+ }
- free (sss) ;
+ free (sss);
}
+void
+printstringbasepos (char *ss, int w, int basepos)
+{
+ char *sss;
+ char *sx;
+ int pos = basepos;
+
+ ZALLOC(sss, w+1, char);
+ cclear (sss, CNULL, w + 1);
+
+ sx = ss;
+ for (;;)
+ {
+ strncpy (sss, sx, w);
+ if (strlen (sss) <= 0)
+ break;
+ printf ("%12d ", pos);
+ printf ("%s\n", sss);
+ sx += w;
+ pos += w;
+ }
-void printstringbasepos(char *ss, int w, int basepos)
-{
- char *sss ;
- char *sx ;
- int pos = basepos ;
-
- ZALLOC(sss, w+1, char) ;
- cclear(sss, CNULL, w+1) ;
-
- sx = ss ;
- for (;;) {
- strncpy(sss, sx, w) ;
- if (strlen(sss) <= 0) break ;
- printf("%12d ", pos) ;
- printf("%s\n", sss) ;
- sx += w ;
- pos += w ;
- }
-
- free (sss) ;
+ free (sss);
}
-
-
-void printstring(char *ss, int w)
+void
+printstring (char *ss, int w)
{
- printstringf(ss, w, stdout) ;
+ printstringf (ss, w, stdout);
}
-
-void rndit(double *a, double *b, int n)
+void
+rndit (double *a, double *b, int n)
{
- int i ;
+ int i;
- for (i=0; i<n; ++i) {
- a[i] = nearbyint(b[i]) ;
- }
+ for (i = 0; i < n; ++i)
+ {
+ a[i] = nearbyint (b[i]);
+ }
}
-
-void fixit(int *a, double *b, int n)
+void
+fixit (int *a, double *b, int n)
{
- int i ;
- for (i=0; i<n; i++) {
- a[i] = nnint(b[i]) ;
- }
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ a[i] = nnint (b[i]);
+ }
}
-int findfirst(int *a, int n, int val)
+int
+findfirst (int *a, int n, int val)
{
- int i ;
- for (i=0 ; i<n; i++) {
- if (a[i] == val) return i ;
- }
- return -1 ;
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (a[i] == val)
+ return i;
+ }
+ return -1;
}
-int findfirstl(long *a, int n, long val)
+int
+findfirstl (long *a, int n, long val)
{
- int i ;
- for (i=0 ; i<n; i++) {
- if (a[i] == val) return i ;
- }
- return -1 ;
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (a[i] == val)
+ return i;
+ }
+ return -1;
}
-int findfirstu(unsigned int *a, int n, unsigned int val)
+int
+findfirstu (unsigned int *a, int n, unsigned int val)
{
- int i ;
- for (i=0 ; i<n; i++) {
- if (a[i] == val) return i ;
- }
- return -1 ;
+ int i;
+ for (i = 0; i < n; i++)
+ {
+ if (a[i] == val)
+ return i;
+ }
+ return -1;
}
-int findlastu(unsigned int *a, int n, unsigned int val)
+int
+findlastu (unsigned int *a, int n, unsigned int val)
{
- int i ;
- for (i=n-1 ; i>=0; i--) {
- if (a[i] == val) return i ;
- }
- return -1 ;
+ int i;
+ for (i = n - 1; i >= 0; i--)
+ {
+ if (a[i] == val)
+ return i;
+ }
+ return -1;
}
-int findlast(int *a, int n, int val)
+int
+findlast (int *a, int n, int val)
{
- int i ;
- for (i=n-1 ; i>=0; i--) {
- if (a[i] == val) return i ;
- }
- return -1 ;
+ int i;
+ for (i = n - 1; i >= 0; i--)
+ {
+ if (a[i] == val)
+ return i;
+ }
+ return -1;
}
-int binsearch (int *a, int n, int val)
+int
+binsearch (int *a, int n, int val)
// binary search. a sorted in ascending order
{
#define TINYS 12
- int x, m, h, v ;
-
- if (n<=TINYS) return findfirst(a, n, val) ;
- if (val<a[0]) return -1 ;
- if (val>a[n-1]) return -1 ;
- h = n/2 ;
- v = a[h] ;
- if (val<v) return binsearch (a, h, val) ;
- if (val==v) return h ;
- m = (n-1) - (h+1) + 1 ;
- x = binsearch (a+h+1, m, val) ;
- if (x<0) return -1 ;
- return x + h + 1 ;
+ int x, m, h, v;
+
+ if (n <= TINYS)
+ return findfirst (a, n, val);
+ if (val < a[0])
+ return -1;
+ if (val > a[n - 1])
+ return -1;
+ h = n / 2;
+ v = a[h];
+ if (val < v)
+ return binsearch (a, h, val);
+ if (val == v)
+ return h;
+ m = (n - 1) - (h + 1) + 1;
+ x = binsearch (a + h + 1, m, val);
+ if (x < 0)
+ return -1;
+ return x + h + 1;
}
-void idperm(int *a, int n)
+void
+idperm (int *a, int n)
{
- int i ;
- for (i=0; i<n; i++)
- a[i] = i ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = i;
}
-double NPlog2(double y)
+double
+NPlog2 (double y)
{
- if (y<=0.0) fatalx("(NPlog2) negative argument\n") ;
- return (log(y)/log(2.0)) ;
+ if (y <= 0.0)
+ fatalx ("(NPlog2) negative argument\n");
+ return (log (y) / log (2.0));
}
-double logfac(int n)
+double
+logfac (int n)
/**
log (factorial n))
-*/
+ */
{
- double y, x ;
- x = (double) (n+1) ;
- y = lgamma(x) ;
- return (y) ;
+ double y, x;
+ x = (double) (n + 1);
+ y = lgamma (x);
+ return (y);
}
-double logbino(int n, int k)
+double
+logbino (int n, int k)
/* log n choose k */
{
- double top, bot ;
-
- top = logfac(n) ;
- bot = logfac(n-k) + logfac(k) ;
+ double top, bot;
+
+ top = logfac (n);
+ bot = logfac (n - k) + logfac (k);
- return top-bot ;
+ return top - bot;
}
-double loghprob(int n, int a, int m, int k)
+double
+loghprob (int n, int a, int m, int k)
// http://www.math.uah.edu/stat/urn/Hypergeometric.xhtml
{
-/**
- n balls a black. Pick m without replacement
- return log prob (k black)
-*/
+ /**
+ n balls a black. Pick m without replacement
+ return log prob (k black)
+ */
-double ytop, ybot ;
+ double ytop, ybot;
-if (k<0) return -1.0e30 ;
-if (k>a) return -1.0e30 ;
-if (k>m) return -1.0e30 ;
-if ((m-k)>(n-a)) return -1.0e30 ;
+ if (k < 0)
+ return -1.0e30;
+ if (k > a)
+ return -1.0e30;
+ if (k > m)
+ return -1.0e30;
+ if ((m - k) > (n - a))
+ return -1.0e30;
- ytop = logbino(a, k) + logbino(n-a, m-k) ;
- ybot = logbino(n, m) ;
- return ytop - ybot ;
+ ytop = logbino (a, k) + logbino (n - a, m - k);
+ ybot = logbino (n, m);
+ return ytop - ybot;
}
-
-double log2fac(int n)
+double
+log2fac (int n)
/**
log base2 (factorial n))
-*/
+ */
{
- double y, x ;
- x = (double) (n+1) ;
- y = lgamma(x) ;
- return (y/log(2.0)) ;
+ double y, x;
+ x = (double) (n + 1);
+ y = lgamma (x);
+ return (y / log (2.0));
}
-double addlog(double a, double b)
+double
+addlog (double a, double b)
{
- /* given a = log(A)
- b = log(B)
- returns log(A+B)
- with precautions for overflow etc
-*/
- double x, y, z ;
+ /* given a = log(A)
+ b = log(B)
+ returns log(A+B)
+ with precautions for overflow etc
+ */
+ double x, y, z;
- x = MIN(a,b) ;
- y = MAX(a,b) ;
+ x = MIN(a, b);
+ y = MAX(a, b);
-/**
- answer is log(1 + A/B) + log (B)
-*/
- z = x-y ;
- if (z < -50.0) return y ;
- z = 1.0+exp(z) ;
- z = log(z) + y ;
- return (z) ;
+ /**
+ answer is log(1 + A/B) + log (B)
+ */
+ z = x - y;
+ if (z < -50.0)
+ return y;
+ z = 1.0 + exp (z);
+ z = log (z) + y;
+ return (z);
}
-
-
-double vldot(double *x, double *y, int n)
+double
+vldot (double *x, double *y, int n)
/**
x. log(y)
-*/
+ */
{
- double *z, ans ;
- double tiny = 1.0e-19 ;
- int i ;
+ double *z, ans;
+ double tiny = 1.0e-19;
+ int i;
- ZALLOC(z, n, double) ;
- vsp(z, y, 1.0e-20, n) ;
- vlog(z, z, n) ;
+ ZALLOC(z, n, double);
+ vsp (z, y, 1.0e-20, n);
+ vlog (z, z, n);
- ans = 0.0 ;
- for (i=0; i< n ; i++) {
- if (x[i]>tiny) ans += x[i]*z[i] ;
- }
- free (z) ;
- return ans ;
+ ans = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ if (x[i] > tiny)
+ ans += x[i] * z[i];
+ }
+ free (z);
+ return ans;
}
-int ipow2 (int l)
+int
+ipow2 (int l)
{
- return nnint(pow(2.0, l)) ;
+ return nnint (pow (2.0, l));
}
-double pow10 (double x)
+double
+pow10 (double x)
{
- return exp(x*log(10.0)) ;
+ return exp (x * log (10.0));
}
-
-double vpow10 (double *a, double *b, int n)
+double
+vpow10 (double *a, double *b, int n)
{
- int i ;
- for (i=0; i< n; i++)
- a[i] = exp(b[i] * log(10.0)) ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = exp (b[i] * log (10.0));
}
-double vlog10 (double *a, double *b, int n)
+double
+vlog10 (double *a, double *b, int n)
{
- int i ;
- for (i=0; i< n; i++)
- a[i] = log10(b[i]) ;
+ int i;
+ for (i = 0; i < n; i++)
+ a[i] = log10 (b[i]);
}
-void transpose(double *aout, double *ain, int m, int n)
+void
+transpose (double *aout, double *ain, int m, int n)
/**
aout and ain must be identical or not overlap
does matrix transpose
input m vectors of length n (m x n)
output n vectors of length m
-*/
+ */
{
- double *ttt ;
- int i, j, k1, k2 ;
- if (aout == ain) {
- ZALLOC(ttt, m*n, double) ;
- }
- else ttt = aout ;
-
- for (i=0; i<m; i++)
- for (j=0; j<n; j++) {
- k1 = i*n+j ;
- k2 = j*m+i ;
- ttt[k2] = ain[k1] ;
+ double *ttt;
+ int i, j, k1, k2;
+ if (aout == ain)
+ {
+ ZALLOC(ttt, m*n, double);
}
- if (aout == ain) {
- copyarr(ttt, aout, m*n) ;
- free(ttt) ;
+ else
+ ttt = aout;
+
+ for (i = 0; i < m; i++)
+ for (j = 0; j < n; j++)
+ {
+ k1 = i * n + j;
+ k2 = j * m + i;
+ ttt[k2] = ain[k1];
+ }
+ if (aout == ain)
+ {
+ copyarr (ttt, aout, m * n);
+ free (ttt);
}
}
-int **initarray_2Dint(int numrows, int numcolumns, int initval)
+int **
+initarray_2Dint (int numrows, int numcolumns, int initval)
{
- int i,j;
+ int i, j;
int **array;
-
- ZALLOC(array, numrows, int *) ;
- for (i=0; i<numrows; i++) {
- ZALLOC(array[i],numcolumns,int);
- if (initval != 0)
- ivclear(array[i], initval, numcolumns) ;
- }
+ ZALLOC(array, numrows, int *);
+ for (i = 0; i < numrows; i++)
+ {
+ ZALLOC(array[i], numcolumns, int);
+ if (initval != 0)
+ ivclear (array[i], initval, numcolumns);
+ }
return array;
}
-long **initarray_2Dlong(int numrows, int numcolumns, int initval)
+long **
+initarray_2Dlong (int numrows, int numcolumns, int initval)
{
- int i,j;
- long **array;
+ int i, j;
+ long **array;
-
- ZALLOC(array, numrows, long *) ;
- for (i=0; i<numrows; i++) {
- ZALLOC(array[i],numcolumns,long);
- if (initval != 0)
- lvclear(array[i], initval, numcolumns) ;
- }
+ ZALLOC(array, numrows, long *);
+ for (i = 0; i < numrows; i++)
+ {
+ ZALLOC(array[i], numcolumns, long);
+ if (initval != 0)
+ lvclear (array[i], initval, numcolumns);
+ }
return array;
}
-
-void free2Dint (int ***xx, int numrows)
+void
+free2Dint (int ***xx, int numrows)
{
- int **array ;
- int i ;
- array = *xx ;
+ int **array;
+ int i;
+ array = *xx;
- for (i=numrows-1; i>=0; i--) {
- free(array[i]) ;
- }
- free(array) ;
- *xx = NULL ;
+ for (i = numrows - 1; i >= 0; i--)
+ {
+ free (array[i]);
+ }
+ free (array);
+ *xx = NULL;
}
-void free_darray (double **xx)
+void
+free_darray (double **xx)
{
- free(*xx) ;
- *xx = NULL ;
+ free (*xx);
+ *xx = NULL;
}
-void free_iarray (int **xx)
+void
+free_iarray (int **xx)
{
- free(*xx) ;
- *xx = NULL ;
+ free (*xx);
+ *xx = NULL;
}
-
-double **initarray_2Ddouble(int numrows, int numcolumns, double initval)
+double **
+initarray_2Ddouble (int numrows, int numcolumns, double initval)
{
- int i,j;
+ int i, j;
double **array;
-
- ZALLOC(array, numrows, double *) ;
- for (i=0; i<numrows; i++) {
- ZALLOC(array[i], numcolumns,double);
- if (initval != 0.0)
- vclear(array[i], initval, numcolumns) ;
- }
+ ZALLOC(array, numrows, double *);
+ for (i = 0; i < numrows; i++)
+ {
+ ZALLOC(array[i], numcolumns, double);
+ if (initval != 0.0)
+ vclear (array[i], initval, numcolumns);
+ }
return array;
}
-long double **initarray_2Dlongdouble(int numrows, int numcolumns, long double initval)
+long double **
+initarray_2Dlongdouble (int numrows, int numcolumns, long double initval)
{
- int i,j;
+ int i, j;
long double **array, *bb;
-
- ZALLOC(array, numrows, long double *) ;
- for (i=0; i<numrows; i++) {
- ZALLOC(array[i], numcolumns, long double);
- if (initval != 0.0) {
- bb = array[i] ;
- for (j=0; j<numcolumns; ++j) {
- bb[j] = initval ;
- }
- }
- }
+ ZALLOC(array, numrows, long double *);
+ for (i = 0; i < numrows; i++)
+ {
+ ZALLOC(array[i], numcolumns, long double);
+ if (initval != 0.0)
+ {
+ bb = array[i];
+ for (j = 0; j < numcolumns; ++j)
+ {
+ bb[j] = initval;
+ }
+ }
+ }
return array;
}
-
-void clear2D(double ***xx, int numrows, int numcols, double val)
+void
+clear2D (double ***xx, int numrows, int numcols, double val)
{
- double **array ;
- int i ;
- array = *xx ;
+ double **array;
+ int i;
+ array = *xx;
- for (i=numrows-1; i>=0; i--) {
- vclear(array[i], val, numcols) ;
- }
+ for (i = numrows - 1; i >= 0; i--)
+ {
+ vclear (array[i], val, numcols);
+ }
}
-void iclear2D(int ***xx, int numrows, int numcols, int val)
+void
+iclear2D (int ***xx, int numrows, int numcols, int val)
{
- int **array ;
- int i ;
+ int **array;
+ int i;
- array = *xx ;
+ array = *xx;
- for (i=numrows-1; i>=0; i--) {
- ivclear(array[i], val, numcols) ;
- }
+ for (i = numrows - 1; i >= 0; i--)
+ {
+ ivclear (array[i], val, numcols);
+ }
}
-
-void free2D (double ***xx, int numrows)
+void
+free2D (double ***xx, int numrows)
{
- double **array ;
- int i ;
- array = *xx ;
+ double **array;
+ int i;
+ array = *xx;
- for (i=numrows-1; i>=0; i--) {
- free(array[i]) ;
- }
- free(array) ;
- *xx = NULL ;
+ for (i = numrows - 1; i >= 0; i--)
+ {
+ free (array[i]);
+ }
+ free (array);
+ *xx = NULL;
}
-
-void free2Dlongdouble (long double ***xx, int numrows)
+
+void
+free2Dlongdouble (long double ***xx, int numrows)
{
- long double **array ;
- int i ;
+ long double **array;
+ int i;
- array = *xx ;
+ array = *xx;
- for (i=numrows-1; i>=0; i--) {
- free(array[i]) ;
- }
- free(array) ;
- *xx = NULL ;
+ for (i = numrows - 1; i >= 0; i--)
+ {
+ free (array[i]);
+ }
+ free (array);
+ *xx = NULL;
}
-void addoutmul(double *mat, double *v, double mul, int n)
-{
- int a, b ;
- for (a=0; a<n; ++a) {
- for (b=0; b<n; ++b) {
- mat[a*n+b] += v[a]*v[b]*mul ;
- }
- }
+void
+addoutmul (double *mat, double *v, double mul, int n)
+{
+ int a, b;
+ for (a = 0; a < n; ++a)
+ {
+ for (b = 0; b < n; ++b)
+ {
+ mat[a * n + b] += v[a] * v[b] * mul;
+ }
+ }
}
-
-
-
-void addouter(double *out, double *a, int n)
+void
+addouter (double *out, double *a, int n)
/*
add outerprod(a) to out
trival to recode to make ~ 2 * faster
-*/
+ */
{
- addoutmul(out, a, 1.0, n) ;
+ addoutmul (out, a, 1.0, n);
}
-void subouter(double *out, double *a, int n)
+void
+subouter (double *out, double *a, int n)
/*
subtract outerprod(a) to out
trival to recode to make ~ 2 * faster
-*/
+ */
{
- addoutmul(out, a, -1.0, n) ;
+ addoutmul (out, a, -1.0, n);
}
-double bal1 (double *a, int n)
+double
+bal1 (double *a, int n)
// WARNING a is input and output
{
- double y ;
+ double y;
- y = asum(a, n) ;
- if (y<=0.0) fatalx("bad bal1\n") ;
- vst(a, a, 1.0/y, n) ;
- return y ;
+ y = asum (a, n);
+ if (y <= 0.0)
+ fatalx ("bad bal1\n");
+ vst (a, a, 1.0 / y, n);
+ return y;
}
-double logmultinom(int *cc, int n)
+double
+logmultinom (int *cc, int n)
/* log multinomial */
{
- int t, k, i ;
- double y, ytot ;
-
- if (n<=1) return 0.0 ;
- t = intsum(cc, n) ;
- if (t==0) return 0.0 ;
- ytot = 0 ;
- for (i=0; i<n-1; i++) {
- k = cc[i] ;
- y = logbino(t,k) ;
- ytot += y ;
- t -= k ;
- }
- return ytot ;
-}
-void flipiarr(int *a, int *b, int n)
+ int t, k, i;
+ double y, ytot;
+
+ if (n <= 1)
+ return 0.0;
+ t = intsum (cc, n);
+ if (t == 0)
+ return 0.0;
+ ytot = 0;
+ for (i = 0; i < n - 1; i++)
+ {
+ k = cc[i];
+ y = logbino (t, k);
+ ytot += y;
+ t -= k;
+ }
+ return ytot;
+}
+void
+flipiarr (int *a, int *b, int n)
// reverse array
{
- int *x, k ;
- ZALLOC(x, n, int) ;
+ int *x, k;
+ ZALLOC(x, n, int);
- for (k=0; k<n; ++k) {
- x[n-1-k] = b[k] ;
- }
-
- copyiarr(x, a, n) ;
+ for (k = 0; k < n; ++k)
+ {
+ x[n - 1 - k] = b[k];
+ }
- free(x) ;
+ copyiarr (x, a, n);
+ free (x);
}
-void fliparr(double *a, double *b, int n)
+void
+fliparr (double *a, double *b, int n)
{
- double *x ;
- int k ;
+ double *x;
+ int k;
- ZALLOC(x, n, double) ;
+ ZALLOC(x, n, double);
- for (k=0; k<n; ++k) {
- x[n-1-k] = b[k] ;
- }
+ for (k = 0; k < n; ++k)
+ {
+ x[n - 1 - k] = b[k];
+ }
- copyarr(x, a, n) ;
+ copyarr (x, a, n);
- free(x) ;
+ free (x);
}
-void vcompl(double *a, double *b, int n)
+void
+vcompl (double *a, double *b, int n)
// a <- 1 - b
{
- double *x ;
- ZALLOC(x, n, double) ;
+ double *x;
+ ZALLOC(x, n, double);
+
+ vvm (x, x, b, n);
+ vsp (x, x, 1.0, n);
- vvm(x, x, b, n) ;
- vsp(x, x, 1.0, n) ;
-
- copyarr(x, a, n) ;
+ copyarr (x, a, n);
- free(x) ;
+ free (x);
}
-void setidmat(double *a, int n)
+void
+setidmat (double *a, int n)
// a <- identity matrix
{
- int i ;
- vzero(a, n*n) ;
- for (i=0; i<n; i++) {
- a[i*n+i] = 1.0 ;
- }
+ int i;
+ vzero (a, n * n);
+ for (i = 0; i < n; i++)
+ {
+ a[i * n + i] = 1.0;
+ }
}
-
-int stripit(double *a, double *b, int *x, int len)
+int
+stripit (double *a, double *b, int *x, int len)
// copy b to a leave out elems where x < 0
{
- int k, n ;
+ int k, n;
- n = 0 ;
- for (k=0; k<len; ++k) {
- if (x[k] >= 0) {
- a[n] = b[k] ;
- ++n ;
+ n = 0;
+ for (k = 0; k < len; ++k)
+ {
+ if (x[k] >= 0)
+ {
+ a[n] = b[k];
+ ++n;
+ }
}
- }
- return n ;
+ return n;
}
-int istripit(int *a, int *b, int *x, int len)
+int
+istripit (int *a, int *b, int *x, int len)
// copy b to a leave out elems where x < 0
{
- int k, n ;
+ int k, n;
- n = 0 ;
- for (k=0; k<len; ++k) {
- if (x[k] >= 0) {
- a[n] = b[k] ;
- ++n ;
+ n = 0;
+ for (k = 0; k < len; ++k)
+ {
+ if (x[k] >= 0)
+ {
+ a[n] = b[k];
+ ++n;
+ }
}
- }
- return n ;
+ return n;
}
-int cstripit(char **a, char **b, int *x, int len)
+int
+cstripit (char **a, char **b, int *x, int len)
// copy b to a leave out elems where x < 0
{
- int k, n ;
+ int k, n;
- n = 0 ;
- for (k=0; k<len; ++k) {
- if (x[k] >= 0) {
- a[n] = b[k] ;
- ++n ;
+ n = 0;
+ for (k = 0; k < len; ++k)
+ {
+ if (x[k] >= 0)
+ {
+ a[n] = b[k];
+ ++n;
+ }
}
- }
- return n ;
+ return n;
}
-void mapit(int *a, int *b, int n, int inval, int outval)
+void
+mapit (int *a, int *b, int n, int inval, int outval)
{
- int k ;
+ int k;
- copyiarr(b, a, n) ;
- for (k=0; k<n; ++k) {
- if (a[k]==inval) a[k] = outval ;
- }
+ copyiarr (b, a, n);
+ for (k = 0; k < n; ++k)
+ {
+ if (a[k] == inval)
+ a[k] = outval;
+ }
}
-int ifall(int n, int k)
+int
+ifall (int n, int k)
// falling factorial
{
- int prod = 1, t=n, j ;
+ int prod = 1, t = n, j;
- for (j=0; j<k; ++j) {
- prod *= t ;
- --t ;
- }
- return prod ;
+ for (j = 0; j < k; ++j)
+ {
+ prod *= t;
+ --t;
+ }
+ return prod;
}
-double hlife(double val)
+double
+hlife (double val)
{
- return -log(2.0)/log(val) ;
+ return -log (2.0) / log (val);
}
-void *topheap ()
+void *
+topheap ()
// find top of heap (address). Useful for finding memory leaks
{
- return sbrk(0) ;
+ return sbrk (0);
}
-void swap (double *pa, double *pb)
+void
+swap (double *pa, double *pb)
{
- double a, b, t ;
+ double a, b, t;
- a = *pa ; b = *pb ;
- t = b ; b = a ; a = t ;
- *pa = a ; *pb = b ;
+ a = *pa;
+ b = *pb;
+ t = b;
+ b = a;
+ a = t;
+ *pa = a;
+ *pb = b;
}
-void iswap (int *pa, int *pb)
+void
+iswap (int *pa, int *pb)
{
- int a, b, t ;
+ int a, b, t;
- a = *pa ; b = *pb ;
- t = b ; b = a ; a = t ;
- *pa = a ; *pb = b ;
+ a = *pa;
+ b = *pb;
+ t = b;
+ b = a;
+ a = t;
+ *pa = a;
+ *pb = b;
}
-void cswap(char *c1, char *c2)
+void
+cswap (char *c1, char *c2)
{
- char cc ;
-
- cc = *c1 ;
- *c1 = *c2 ;
- *c2 = cc ;
+ char cc;
+ cc = *c1;
+ *c1 = *c2;
+ *c2 = cc;
}
-int kodeitb(int *xx, int len, int base)
+int
+kodeitb (int *xx, int len, int base)
{
- int t = 0 , i ;
+ int t = 0, i;
- for (i=0; i<len; ++i) {
- t *= base ;
- t += xx[i] ;
- }
- return t ;
+ for (i = 0; i < len; ++i)
+ {
+ t *= base;
+ t += xx[i];
+ }
+ return t;
}
-int dekodeitb(int *xx, int kode, int len, int base)
+int
+dekodeitb (int *xx, int kode, int len, int base)
{
- int i, t ;
+ int i, t;
- t = kode ;
- for (i=len-1; i>=0; --i) {
- xx[i] = t % base ;
- t /= base ;
- }
- return intsum(xx, len) ; // weight
+ t = kode;
+ for (i = len - 1; i >= 0; --i)
+ {
+ xx[i] = t % base;
+ t /= base;
+ }
+ return intsum (xx, len); // weight
}
-void copyarr2D(double **a, double **b, int nrows, int ncols)
+void
+copyarr2D (double **a, double **b, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- copyarr(a[x], b[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ copyarr (a[x], b[x], ncols);
+ }
}
-void copyiarr2D(int **a, int **b, int nrows, int ncols)
+void
+copyiarr2D (int **a, int **b, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- copyiarr(a[x], b[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ copyiarr (a[x], b[x], ncols);
+ }
}
-
-void plus2Dint(int **a, int **b, int **c, int nrows, int ncols)
+void
+plus2Dint (int **a, int **b, int **c, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- ivvp(a[x], b[x], c[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ ivvp (a[x], b[x], c[x], ncols);
+ }
}
-void minus2Dint (int **a, int **b, int **c, int nrows, int ncols)
+void
+minus2Dint (int **a, int **b, int **c, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- ivvm(a[x], b[x], c[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ ivvm (a[x], b[x], c[x], ncols);
+ }
}
-void plus2D(double **a, double **b, double **c, int nrows, int ncols)
+void
+plus2D (double **a, double **b, double **c, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- vvp(a[x], b[x], c[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ vvp (a[x], b[x], c[x], ncols);
+ }
}
-void minus2D(double **a, double **b, double **c, int nrows, int ncols)
+void
+minus2D (double **a, double **b, double **c, int nrows, int ncols)
{
- int x ;
+ int x;
- for (x=0; x < nrows; ++x) {
- vvm(a[x], b[x], c[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ vvm (a[x], b[x], c[x], ncols);
+ }
}
-void sum2D(double *a, double **b, int nrows, int ncols)
+void
+sum2D (double *a, double **b, int nrows, int ncols)
{
- int x ;
+ int x;
- vzero(a, ncols) ;
- for (x=0; x < nrows; ++x) {
- vvp(a, a, b[x], ncols) ;
- }
+ vzero (a, ncols);
+ for (x = 0; x < nrows; ++x)
+ {
+ vvp (a, a, b[x], ncols);
+ }
}
-int total2D(double **a, int nrows, int ncols)
+int
+total2D (double **a, int nrows, int ncols)
{
- int x ;
- double sum=0 ;
+ int x;
+ double sum = 0;
- for (x=0; x < nrows; ++x) {
- sum += asum(a[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ sum += asum (a[x], ncols);
+ }
- return sum ;
+ return sum;
}
-int total2Dint(int **a, int nrows, int ncols)
+int
+total2Dint (int **a, int nrows, int ncols)
{
- int x, sum=0 ;
+ int x, sum = 0;
- for (x=0; x < nrows; ++x) {
- sum += intsum(a[x], ncols) ;
- }
+ for (x = 0; x < nrows; ++x)
+ {
+ sum += intsum (a[x], ncols);
+ }
- return sum ;
+ return sum;
}
-
/**
mixed modulus coding (see .../popgen/kimfitdir
-*/
-int kodeitbb(int *xx, int len, int *baselist)
-{
- int t = 0 , i, base ;
-
- for (i=0; i<len; ++i) {
- base = baselist[i] ;
- t *= base ;
- t += xx[i] ;
- if (t<0) fatalx("(kodeitbb) overflow\n") ;
- }
- return t ;
+ */
+int
+kodeitbb (int *xx, int len, int *baselist)
+{
+ int t = 0, i, base;
+
+ for (i = 0; i < len; ++i)
+ {
+ base = baselist[i];
+ t *= base;
+ t += xx[i];
+ if (t < 0)
+ fatalx ("(kodeitbb) overflow\n");
+ }
+ return t;
}
-int dekodeitbb(int *xx, int kode, int len, int *baselist)
+int
+dekodeitbb (int *xx, int kode, int len, int *baselist)
{
// return weight
- int i, t, base ;
+ int i, t, base;
- t = kode ;
- for (i=len-1; i>=0; --i) {
- base = baselist[i] ;
- xx[i] = t % base ;
- t /= base ;
- }
- return intsum(xx, len) ;
+ t = kode;
+ for (i = len - 1; i >= 0; --i)
+ {
+ base = baselist[i];
+ xx[i] = t % base;
+ t /= base;
+ }
+ return intsum (xx, len);
}
-long nextprime(long num)
+long
+nextprime (long num)
// return nextprime >= num
{
- long x ;
- int t ;
+ long x;
+ int t;
- for (x=num ; ; ++x) {
- t = isprime(x) ;
- if (t==YES) return x ;
- }
+ for (x = num;; ++x)
+ {
+ t = isprime (x);
+ if (t == YES)
+ return x;
+ }
}
-int isprime(long num)
+int
+isprime (long num)
// naive algorithm. Implement Pollard rho at some time
{
- int top, x, t ;
+ int top, x, t;
- if (num < 2) return NO ;
- if (num == 2) return YES ;
- top = nnint(sqrt(num)) ;
+ if (num < 2)
+ return NO;
+ if (num == 2)
+ return YES;
+ top = nnint (sqrt (num));
- for (x=2; x <= top; ++x) {
- t = num % x ;
- if (t == 0) return NO ;
- }
+ for (x = 2; x <= top; ++x)
+ {
+ t = num % x;
+ if (t == 0)
+ return NO;
+ }
- return YES ;
+ return YES;
}
-int irevcomp (int xx, int stringlen)
+int
+irevcomp (int xx, int stringlen)
// consists of stringlen "mininibbles" (2 bits)
{
- int aa[32], xxx, k, t ;
-
- if (stringlen > 16) fatalx("stringlen > 16\n") ;
- xxx = xx ;
- for (k=0; k<stringlen; ++k) {
- aa[k] = (xxx & 3) ^ 3 ;
- xxx = xxx >> 2 ;
- }
- xxx = 0 ;
- for (k=0; k<stringlen; ++k) {
- t = aa[k] ;
- xxx = (xxx << 2) | t ;
- }
- return xxx ;
-}
-long lrevcomp (long xx, int stringlen)
+ int aa[32], xxx, k, t;
+
+ if (stringlen > 16)
+ fatalx ("stringlen > 16\n");
+ xxx = xx;
+ for (k = 0; k < stringlen; ++k)
+ {
+ aa[k] = (xxx & 3) ^ 3;
+ xxx = xxx >> 2;
+ }
+ xxx = 0;
+ for (k = 0; k < stringlen; ++k)
+ {
+ t = aa[k];
+ xxx = (xxx << 2) | t;
+ }
+ return xxx;
+}
+long
+lrevcomp (long xx, int stringlen)
// consists of stringlen "mininibbles" (2 bits)
// could be rewritten to avoid array aa + 1 loop.
{
- int aa[32], k, t ;
- long xxx ;
+ int aa[32], k, t;
+ long xxx;
- if (stringlen > 32) fatalx("stringlen > 32\n") ;
- xxx = xx ;
- for (k=0; k<stringlen; ++k) {
- aa[k] = (xxx & 3) ^ 3 ;
- xxx = xxx >> 2 ;
- }
- xxx = 0 ;
- for (k=0; k<stringlen; ++k) {
- t = aa[k] ;
- xxx = (xxx << 2) | t ;
- }
- return xxx ;
+ if (stringlen > 32)
+ fatalx ("stringlen > 32\n");
+ xxx = xx;
+ for (k = 0; k < stringlen; ++k)
+ {
+ aa[k] = (xxx & 3) ^ 3;
+ xxx = xxx >> 2;
+ }
+ xxx = 0;
+ for (k = 0; k < stringlen; ++k)
+ {
+ t = aa[k];
+ xxx = (xxx << 2) | t;
+ }
+ return xxx;
}
-void ismatch(int *a, int *b, int n, int val)
+void
+ismatch (int *a, int *b, int n, int val)
{
- int i ;
+ int i;
- for (i=0; i<n; i++) {
- if (b[i] == val) a[i] = YES ;
- else a[i] = NO ;
+ for (i = 0; i < n; i++)
+ {
+ if (b[i] == val)
+ a[i] = YES;
+ else
+ a[i] = NO;
- }
+ }
}
-int pmult(double *a, double *b, double *c, int nb, int nc)
+int
+pmult (double *a, double *b, double *c, int nb, int nc)
// polynomial multiplication
{
- double *ww ;
- int i, j ;
+ double *ww;
+ int i, j;
- ZALLOC(ww, nb+nc+1, double) ;
+ ZALLOC(ww, nb+nc+1, double);
- for (i=0; i<=nb; ++i) {
- for (j=0; j<=nc; ++j) {
- ww[i+j] += b[i]*c[j] ;
+ for (i = 0; i <= nb; ++i)
+ {
+ for (j = 0; j <= nc; ++j)
+ {
+ ww[i + j] += b[i] * c[j];
+ }
}
- }
- copyarr(ww, a, nb+nc+1) ;
- free(ww) ;
+ copyarr (ww, a, nb + nc + 1);
+ free (ww);
- return nb+nc ;
+ return nb + nc;
}
-void pdiff(double *a, double *b, int deg)
+void
+pdiff (double *a, double *b, int deg)
// differentiate univariate polynomial
{
- double *ww, y;
- int k ;
+ double *ww, y;
+ int k;
- ZALLOC(ww, deg+1, double) ;
- for (k=1; k<=deg; ++k) {
- y = (double) k ;
- ww[k-1] = y*b[k] ;
- }
+ ZALLOC(ww, deg+1, double);
+ for (k = 1; k <= deg; ++k)
+ {
+ y = (double) k;
+ ww[k - 1] = y * b[k];
+ }
- copyarr(ww, a, deg+1) ;
- free(ww) ;
+ copyarr (ww, a, deg + 1);
+ free (ww);
}
diff --git a/src/nicksrc/xsearch.c b/src/nicksrc/xsearch.c
index 8634f9b..a122ff0 100644
--- a/src/nicksrc/xsearch.c
+++ b/src/nicksrc/xsearch.c
@@ -4,267 +4,311 @@
#include <nicklib.h>
#include "xsearch.h"
-static ENTRY *xentry ;
-static ENTRY **xxee ;
-static int xxeenum = -1 ;
-static int xnum, xloaded ;
+static ENTRY *xentry;
+static ENTRY **xxee;
+static int xxeenum = -1;
+static int xnum, xloaded;
-static int debug = NO ;
-
-static int fancyhash = NO ;
+static int debug = NO;
+static int fancyhash = NO;
/* ********************************************************************* */
-void xhcreate (int n)
-{
- int t, i ;
- if (xentry != NULL) {
- free(xentry) ;
- }
- if (n==0) fatalx("(xhcreate) zero length\n") ;
- xnum = n ;
- t = xnum % 17 ;
- if (t==0) ++xnum ; // for crude hash below
- ZALLOC (xentry, xnum , ENTRY) ;
- for (i=0; i<xnum; i++) {
- xentry[i].key = NULL ;
- }
- xloaded = 0 ;
+void
+xhcreate (int n)
+{
+ int t, i;
+ if (xentry != NULL)
+ {
+ free (xentry);
+ }
+ if (n == 0)
+ fatalx ("(xhcreate) zero length\n");
+ xnum = n;
+ t = xnum % 17;
+ if (t == 0)
+ ++xnum; // for crude hash below
+ ZALLOC (xentry, xnum , ENTRY);
+ for (i = 0; i < xnum; i++)
+ {
+ xentry[i].key = NULL;
+ }
+ xloaded = 0;
}
-void xhdestroy()
-{
- free(xentry) ;
- xentry = NULL ;
- xnum = xloaded = 0 ;
+void
+xhdestroy ()
+{
+ free (xentry);
+ xentry = NULL;
+ xnum = xloaded = 0;
}
-ENTRY *xhsearch(ENTRY item, ACTION act)
+ENTRY *
+xhsearch (ENTRY item, ACTION act)
{
-
- ENTRY *itempt, *xtempt ;
- int x ;
- char *ccc ;
- double yload ;
-
- itempt = &item ;
- ccc = itempt -> key ;
- x = xlookup(itempt -> key, act) ;
+
+ ENTRY *itempt, *xtempt;
+ int x;
+ char *ccc;
+ double yload;
+
+ itempt = &item;
+ ccc = itempt->key;
+ x = xlookup (itempt->key, act);
if (debug)
- printf("lookup: %s %d\n", itempt -> key, x) ;
- if ((x < 0) && (act == FIND)) return NULL ;
- if ((x>=0) && (act == FIND)) return xentry + x ;
- if ((x<0) && (act == ENTER)) fatalx("duplicate key %s\n", itempt ->key) ;
-
- xtempt = xentry + x ;
- xtempt -> key = itempt -> key ;
- xtempt -> data = itempt -> data ;
- ++xloaded ;
- yload = (double) xloaded / (double) xnum ;
- if (yload>0.9) fatalx("excessive xsearch load\n") ;
- return xtempt ;
+ printf ("lookup: %s %d\n", itempt->key, x);
+ if ((x < 0) && (act == FIND))
+ return NULL;
+ if ((x >= 0) && (act == FIND))
+ return xentry + x;
+ if ((x < 0) && (act == ENTER))
+ fatalx ("duplicate key %s\n", itempt->key);
+
+ xtempt = xentry + x;
+ xtempt->key = itempt->key;
+ xtempt->data = itempt->data;
+ ++xloaded;
+ yload = (double) xloaded / (double) xnum;
+ if (yload > 0.9)
+ fatalx ("excessive xsearch load\n");
+ return xtempt;
}
-int xlookup(char *key, ACTION act)
+int
+xlookup (char *key, ACTION act)
{
- ENTRY *xpt ;
- int xbase, x, k ;
-
- xbase = x = xhash(key) ;
- for (;;) {
- xpt = xentry + x ;
- if (xpt -> key == NULL) {
- if (act == FIND) return -1 ;
- return x ;
- }
- k = strcmp(key, xpt -> key) ;
- if (k==0) {
- if (act == FIND) return x ;
- return -1 ;
- }
- ++x ;
- if (x>=xnum) x=0 ;
- }
+ ENTRY *xpt;
+ int xbase, x, k;
+
+ xbase = x = xhash (key);
+ for (;;)
+ {
+ xpt = xentry + x;
+ if (xpt->key == NULL)
+ {
+ if (act == FIND)
+ return -1;
+ return x;
+ }
+ k = strcmp (key, xpt->key);
+ if (k == 0)
+ {
+ if (act == FIND)
+ return x;
+ return -1;
+ }
+ ++x;
+ if (x >= xnum)
+ x = 0;
+ }
}
-int xhash (char *key)
+int
+xhash (char *key)
{
- int t ;
- t = stringhash(key) ;
- return abs(t) % xnum ;
+ int t;
+ t = stringhash (key);
+ return abs (t) % xnum;
}
-int stringhash(char *key)
-{
+int
+stringhash (char *key)
+{
#define MAXKEYLEN 512
- int xpack[MAXKEYLEN] ;
- int len, wlen, w ;
- unsigned char t ;
- int thash = 7 ;
- int jmax, jmin ;
- int i, j ;
-
- if (key == NULL) return 13 ;
- len = strlen(key) ;
- if (len ==0) return 17 ;
- if (len >= MAXKEYLEN) fatalx("key too long\n") ;
-
- wlen = (len-1)/4 ;
- ++wlen ;
-
- for (i=0; i<wlen; ++i) {
- jmin = 4*i ;
- jmax = MIN(len-1, jmin+3) ;
- w = 0 ;
- for (j= jmin; j <= jmax ; ++j) {
- t = (unsigned char) key[j] ;
- w = (w << 8) ^ t ;
- }
- xpack[i] = xcshift(w, i) ;
- }
- if (debug)
- printf("zz %s %x %x\n", key, w, xpack[0]) ;
- for (i=0; i<wlen; i++) {
- thash += xhash1(xpack[i]) ;
+ int xpack[MAXKEYLEN];
+ int len, wlen, w;
+ unsigned char t;
+ int thash = 7;
+ int jmax, jmin;
+ int i, j;
+
+ if (key == NULL)
+ return 13;
+ len = strlen (key);
+ if (len == 0)
+ return 17;
+ if (len >= MAXKEYLEN)
+ fatalx ("key too long\n");
+
+ wlen = (len - 1) / 4;
+ ++wlen;
+
+ for (i = 0; i < wlen; ++i)
+ {
+ jmin = 4 * i;
+ jmax = MIN(len - 1, jmin + 3);
+ w = 0;
+ for (j = jmin; j <= jmax; ++j)
+ {
+ t = (unsigned char) key[j];
+ w = (w << 8) ^ t;
+ }
+ xpack[i] = xcshift (w, i);
+ }
if (debug)
- printf("zz2 %x\n", thash) ;
- thash = xcshift(thash, 3) ;
- }
- if (debug)
- printf("key: %s hash: %x\n", key, thash) ;
-
- return thash ;
+ printf ("zz %s %x %x\n", key, w, xpack[0]);
+ for (i = 0; i < wlen; i++)
+ {
+ thash += xhash1 (xpack[i]);
+ if (debug)
+ printf ("zz2 %x\n", thash);
+ thash = xcshift (thash, 3);
+ }
+ if (debug)
+ printf ("key: %s hash: %x\n", key, thash);
+ return thash;
}
-int xhash1(int ww)
-
-{
-
- int k, w, w1, w2 ;
- w = xcshift(ww, 17) ;
- if (fancyhash == NO) return 17*w ;
- for (k=0; k<3; ++k) {
- w1 = w >> 16 ;
- w2 = w << 16 ;
- w = w2 ^ xhash2(w1) ^ (w2 >> 16);
- }
- return w ;
+int
+xhash1 (int ww)
+
+{
+
+ int k, w, w1, w2;
+ w = xcshift (ww, 17);
+ if (fancyhash == NO)
+ return 17 * w;
+ for (k = 0; k < 3; ++k)
+ {
+ w1 = w >> 16;
+ w2 = w << 16;
+ w = w2 ^ xhash2 (w1) ^ (w2 >> 16);
+ }
+ return w;
}
-int xhash2 (int x)
+int
+xhash2 (int x)
{
- int xmax = 65535 ;
- int t ;
+ int xmax = 65535;
+ int t;
- if (x==0) return xmax ;
- if (x==xmax) return 0 ;
+ if (x == 0)
+ return xmax;
+ if (x == xmax)
+ return 0;
- t = x * 11 ;
- return t % xmax ;
+ t = x * 11;
+ return t % xmax;
}
-int xcshift(int x, int shft)
+int
+xcshift (int x, int shft)
{
- int a, b ;
+ int a, b;
- if (shft==0) return x ;
- a = x << shft ;
- b = x >> (32 - shft) ;
+ if (shft == 0)
+ return x;
+ a = x << shft;
+ b = x >> (32 - shft);
- return a ^ b ;
+ return a ^ b;
}
-void xdestroy()
+void
+xdestroy ()
{
- int i, num ;
- ENTRY *pitem ;
-
- if (xxee == NULL) return ;
- num = xxeenum ;
- for (i=0; i<num; i++) {
- pitem = xxee[i] ;
- if (pitem == NULL) continue ;
- free(pitem -> key) ;
- free(pitem -> data) ;
- free(pitem) ;
- }
- free(xxee) ;
- xhdestroy() ;
+ int i, num;
+ ENTRY *pitem;
+
+ if (xxee == NULL)
+ return;
+ num = xxeenum;
+ for (i = 0; i < num; i++)
+ {
+ pitem = xxee[i];
+ if (pitem == NULL)
+ continue;
+ free (pitem->key);
+ free (pitem->data);
+ free (pitem);
+ }
+ free (xxee);
+ xhdestroy ();
}
-int xloadsearchx(char **ss, int n)
-
-{
-
- ENTRY item, *pitem ;
- char xx[8] ;
- int i, t ;
-
- xhcreate(2*n) ;
- ZALLOC(xxee, n, ENTRY *) ;
- xxeenum = n ;
- for (i=0; i<n; i++) {
- t = xlookup(ss[i], FIND) ;
- if (t>=0) return i ;
- ZALLOC(xxee[i], 1, ENTRY) ;
- pitem = xxee[i] ;
- pitem -> key = strdup(ss[i]) ;
- sprintf(xx, "%d", i) ;
- pitem -> data = strdup(xx) ;
- xhsearch(*pitem, ENTER) ;
- }
- return -1 ;
+int
+xloadsearchx (char **ss, int n)
+
+{
+
+ ENTRY item, *pitem;
+ char xx[8];
+ int i, t;
+
+ xhcreate (2 * n);
+ ZALLOC(xxee, n, ENTRY *);
+ xxeenum = n;
+ for (i = 0; i < n; i++)
+ {
+ t = xlookup (ss[i], FIND);
+ if (t >= 0)
+ return i;
+ ZALLOC(xxee[i], 1, ENTRY);
+ pitem = xxee[i];
+ pitem->key = strdup (ss[i]);
+ sprintf (xx, "%d", i);
+ pitem->data = strdup (xx);
+ xhsearch (*pitem, ENTER);
+ }
+ return -1;
}
-void xloadsearch(char **ss, int n)
-
-{
-
- ENTRY item, *pitem ;
- char xx[8] ;
- int i ;
-
- xhcreate(2*n) ;
- ZALLOC(xxee, n, ENTRY *) ;
- xxeenum = n ;
- for (i=0; i<n; i++) {
- ZALLOC(xxee[i], 1, ENTRY) ;
- pitem = xxee[i] ;
- pitem -> key = strdup(ss[i]) ;
- sprintf(xx, "%d", i) ;
- pitem -> data = strdup(xx) ;
- xhsearch(*pitem, ENTER) ;
- }
+void
+xloadsearch (char **ss, int n)
+
+{
+
+ ENTRY item, *pitem;
+ char xx[8];
+ int i;
+
+ xhcreate (2 * n);
+ ZALLOC(xxee, n, ENTRY *);
+ xxeenum = n;
+ for (i = 0; i < n; i++)
+ {
+ ZALLOC(xxee[i], 1, ENTRY);
+ pitem = xxee[i];
+ pitem->key = strdup (ss[i]);
+ sprintf (xx, "%d", i);
+ pitem->data = strdup (xx);
+ xhsearch (*pitem, ENTER);
+ }
}
-int xfindit(char *ss)
+int
+xfindit (char *ss)
{
- ENTRY item, *pitem ;
- int k ;
-
- item.key = ss ;
- pitem = xhsearch(item, FIND) ;
- if (pitem == NULL) return -1 ;
- sscanf(pitem -> data, "%d", &k) ;
- return k ;
+ ENTRY item, *pitem;
+ int k;
+
+ item.key = ss;
+ pitem = xhsearch (item, FIND);
+ if (pitem == NULL)
+ return -1;
+ sscanf (pitem->data, "%d", &k);
+ return k;
}
-
-int finddup(char **ss, int n)
+
+int
+finddup (char **ss, int n)
{
- int t ;
+ int t;
- t = xloadsearchx(ss, n) ;
- xdestroy() ;
- return t ;
+ t = xloadsearchx (ss, n);
+ xdestroy ();
+ return t;
}
diff --git a/src/oldgval.c b/src/oldgval.c
deleted file mode 100644
index 35b7f54..0000000
--- a/src/oldgval.c
+++ /dev/null
@@ -1,226 +0,0 @@
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <math.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-#include <stdint.h>
-#include <inttypes.h>
-
-#include <nicklib.h>
-
-#include "admutils.h"
-#include "mcio.h"
-#include "gval.h"
-
-static SNP **xxsnps = NULL;
-static Indiv **xindivmarkers = NULL;
-static int xnrows, xncols;
-static int xnumindivs;
-static int *xxindex = NULL;
-static double *xmean, *xfancy;
-static double **gtable;
-static uint8_t *xind_mask;
-static size_t xtda;
-
-void setgval (
- SNP ** xsnps,
- int nrows,
- Indiv ** indivmarkers,
- int numindivs,
- int *xindex,
- int *xtypes,
- int ncols) {
-
- double *cc;
- int t, n0, n1, i, k, col;
- SNP *cupt;
- double mean, y;
-
- unsetgval();
-
- xxsnps = xsnps;
- xnrows = nrows;
- xncols = ncols;
- xindivmarkers = indivmarkers;
- xnumindivs = numindivs;
- xxindex = xindex;
- ZALLOC(cc, nrows, double);
- ZALLOC(xmean, ncols, double);
- ZALLOC(xfancy, ncols, double);
- vclear(xfancy, 1.0, ncols);
- gtable = initarray_2Ddouble(ncols, 4, 0);
-
- xtda = (xnrows + 3) / 4;
-
- for (i = 0; i < ncols; ++i) {
- col = i;
- cupt = xsnps[i];
- /**
- if (i>=0) {
- printf("zz: %d %s\n", cupt -> ID) ; fflush(stdout) ;
- }
- */
- getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1);
-
- mean = xmean[col] / xfancy[col];
- for (k = 0; k < 3; ++k) {
- y = ((double) k) - mean;
- y *= xfancy[col];
- gtable[col][k] = y / sqrt(2.0);
- }
- gtable[col][3] = 0;
-
- t = MIN(n0, n1);
- if (t == 0) cupt->ignore = YES; // side-effect
- }
-
- set_ind_mask();
-
- free(cc);
-}
-
-void set_ind_mask () {
- size_t i, j, k;
- xind_mask = calloc(xtda, sizeof(uint8_t));
- for (i = 0; i < xnrows; i++) {
- if (xindivmarkers[i]->ignore) {
- j = i / 4;
- k = (3 - (i % 4)) * 2;
- xind_mask[j] |= 3 << k;
- }
- }
-
-}
-
-void unsetgval () {
- if (xxsnps == NULL) return;
-
- xxsnps = NULL;
- xindivmarkers = NULL;
- xxindex = NULL;
-
- free2D(>able, xncols);
-
- gtable = NULL;
-
- free(xmean);
- free(xfancy);
- free(xind_mask);
-}
-
-int getgval (int row, int col, double *val) {
-
- /**
- if (row>=xnrows) fatalx("row index overflow\n") ;
- if (col>=xncols) fatalx("col index overflow\n") ;
- */
-
- return getggval(xxindex[row], col, val);
-
-}
-
-int getggval (int indindx, int col, double *val)
-// indindex is index in full array
-{
- SNP *cupt;
- int t, z;
- double y, mean;
-
- *val = 0;
- if (xindivmarkers[indindx]->ignore) return -1;
- cupt = xxsnps[col];
- t = getgtypes(cupt, indindx);
- if (t < 0) return t;
-
- *val = gtable[col][t];
- return t;
-
-// dead code
- y = (double) t;
- mean = xmean[col] / xfancy[col];
- y -= mean;
- y *= xfancy[col];
-
- /**
- z = ranmod(10000000) ;
- if (z==0) {
- printf("zzcheck: %d %d %12.6f %12.6f %12.6f\n", indindx, col, xmean[col], xfancy[col], y) ;
- }
- */
-
- *val = y / sqrt(2.0);
- return t;
-
-}
-
-// Unpack lookup table
-
-// macro to unpack a single byte
-#define U0(n) { (n >> 6) & 3, (n >> 4) & 3, (n >> 2) & 3, n & 3 }
-
-// macros to build the unpacking table
-#define U1(n) U0(n), U0(n+1), U0(n+2), U0(n+3)
-#define U2(n) U1(n), U1((n)+(1<<2)), U1((n)+(2<<2)), U1((n)+(3<<2))
-#define U3(n) U2(n), U2((n)+(1<<4)), U2((n)+(2<<4)), U2((n)+(3<<4))
-
-// the unpacking table
-static const uint8_t UL[256][4] = { U3(0), U3(1<<6), U3(2<<6), U3(3<<6) };
-
-size_t get_nrows () {
- return (xnrows);
-}
-
-size_t get_ncols () {
- return (xncols);
-}
-
-/**
- * Unpacks a SNP column
- * @param snp_index
- * @param *y arrayref to store data
- */
-void kjg_geno_get_normalized_row (const size_t snp_index, double* y) {
- size_t j;
-
- // Newer method looking up 4 at once
-
- size_t t = xtda;
- uint8_t* packed = xxsnps[snp_index]->pbuff;
- uint8_t* ind_mask = xind_mask;
- double* norm_lookup = gtable[snp_index];
-
- while (--t) {
- const uint8_t* u = UL[*(packed++) | *(ind_mask++)];
- for (j = 0; j < 4; j++)
- *(y++) = norm_lookup[*(u++)];
- }
-
- const uint8_t* u = UL[*packed | *ind_mask];
- for (j = (xtda - 1) * 4; j < xnrows; j++)
- *(y++) = norm_lookup[*(u++)];
-
- // using getgval (slower)
-/*
- for (j = 0; j < xnrows; j++)
- getgval (j, snp_index, y++);
-*/
-
-}
-
-/**
- * Unpacks several SNP coluns
- * @param snp_index index of the SNP
- * @param *unpacked arrayref to store data
- */
-
-size_t kjg_geno_get_normalized_rows (const size_t i, const size_t r, double* Y) {
- size_t j;
- for (j = i; j < i + r && j < xncols; j++) {
- kjg_geno_get_normalized_row(j, Y);
- Y += xnrows;
- }
- return (j - i);
-}
diff --git a/src/oldmakefile b/src/oldmakefile
deleted file mode 100644
index c668612..0000000
--- a/src/oldmakefile
+++ /dev/null
@@ -1,74 +0,0 @@
-CFLAGS = -I../include -I/opt/openblas/include
-LDFLAGS = -L/opt/openblas/lib -static
-LDLIBS = -lgsl -lopenblas -lgfortran -pthread -lm -lrt
-
-ifeq ($(OPTIMIZE), 1)
- CFLAGS += -O2
-endif
-
-ifeq ($(DEBUG), 1)
- CFLAGS += -g # enable debugging
-endif
-
-ifeq ($(PROFILING), 1)
- CFLAGS += -pg # enable profiling
-endif
-
-ND=nicksrc
-ED=eigensrc
-KG=ksrc
-NLIB = $(ND)/libnick.a
-
-# ----- phony targets
-.PHONY: all clean clobber install
-
-EXE = baseprog convertf mergeit pca \
- $(ED)/pcatoy $(ED)/oldsmartpca $(ED)/smartrel $(ED)/smarteigenstrat \
- $(ED)/twstats $(ED)/eigenstrat $(ED)/eigenstratQTL $(ED)/smartpca
-
-all: $(EXE)
-
-install: all
- mv $(EXE) ../bin
-
-clobber:
- rm -f *.o */*.o */*.a
- rm -f $(EXE)
- cd ../bin/ ; rm -f $(notdir, $(EXE)) ; cd ../src
-
-clean:
- rm -f *.o core core.* *.o
-
-# ----- build nicksrc/libnick.a
-$(NLIB):
- $(MAKE) -C $(ND)
-
-baseprog: baseprog.o mcio.o egsubs.o admutils.o h2d.o $(ED)/exclude.o $(NLIB)
-
-convertf: convertf.o mcio.o egsubs.o admutils.o h2d.o $(ED)/exclude.o $(NLIB)
-
-mergeit: mergeit.o mcio.o admutils.o $(NLIB)
-
-pca: pca.o $(ED)/eigsubs.o eigx.o $(NLIB)
-
-$(ED)/pcatoy: $(ED)/pcatoy.o eigensrc/eigsubs.o eigensrc/eigx.o $(NLIB)
-
-$(ED)/oldsmartpca: $(ED)/oldsmartpca.o twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o \
- $(ED)/eigsubs.o \
- $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o $(NLIB)
-
-$(ED)/smartrel: $(ED)/smartrel.o twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o \
- $(ED)/eigsubs.o $(ED)/eigx.o $(ED)/smartsubs.o $(NLIB)
-
-$(ED)/smarteigenstrat: $(ED)/smarteigenstrat.o mcio.o admutils.o $(NLIB)
-
-$(ED)/twstats: $(ED)/twstats.o $(NLIB)
-
-#$(ED)/eigenstrat: $(ED)/eigenstrat.o
-
-#$(ED)/eigenstratQTL: $(ED)/eigenstratQTL.o
-
-$(ED)/smartpca: $(ED)/smartpca.o $(ED)/eigsubs.o $(ED)/exclude.o $(ED)/smartsubs.o $(ED)/eigx.o \
- twsubs.o mcio.o qpsubs.o admutils.o egsubs.o regsubs.o gval.o \
- $(NLIB) \
- $(KG)/kjg_fpca.o $(KG)/kjg_gsl.o
diff --git a/src/oldmcio.c b/src/oldmcio.c
deleted file mode 100644
index 5917d6a..0000000
--- a/src/oldmcio.c
+++ /dev/null
@@ -1,4924 +0,0 @@
-#include <fcntl.h>
-#include <ctype.h>
-#include <mcio.h>
-#include <xsearch.h>
-#include <ranmath.h>
-
-/*! \file mcio.c
- *
- * \brief Input/Output Library
-*/
-
-
-
-/* global data */
-
-extern int numchrom;
-int usecm = NO ; //!< genetic distances are in cMorgans
-int plinkinputmode = NO ;
-static int snprawtab = NO ;
-static int debug = NO ;
-extern char *trashdir ;
-extern int qtmode ; //!< user parameter (phenotype is quantitative)
-extern int verbose ; //!< user parameter (print additional output to stdout)
-extern int familynames ; //!< user parameter (prepend PLINK family names with colon to individual names)
-extern double lp1, lp2 ;
-extern double a1, b1 ;
-
-extern int packmode ; //!< flag - input {is not,is} in packed mode
-extern char *packgenos ; //!< packed genotype data (packit.h)
-extern char *packepath ;
-extern long packlen; //!< allocated size of packgenos data space
-extern long rlen; //!< number of bytes in packgenos space that each SNP's data occupies
-extern int malexhet ; //!< user parameter (retain het genotype data on male X chromosome)
-extern int hashcheck ; //!< user parameter (check input file hashes against input data)
-extern int outputall ;
-extern int sevencolumnped ;
-static int dofreeped = YES ;
-
-int tempnum = 0 ;
-int tempfake = 0 ;
-
-static int *snpord = NULL ; //!< snpord[i] == j if and only if snpm[j] is ith SNP in input file
-static int numsnpord = 0 ; //!< current size of array snpord
-static int *snporda[3] ; //!< Copies of snpord for various data sets (used by mergeit)
-static int numsnporda[3] ; //!< Number of elements of snporda in use
-
-static int badpedignore = NO ; //!< flag - ignore bad allele symbols in PED file
-
-static int maxgenolinelength = -1 ;
-static int tersemode = NO ;
-int checksizemode = YES ;
-int pedignore = YES ;
-enum outputmodetype outputmode = PACKEDANCESTRYMAP ;
-static double maxgpos[MAXCH] ;
-static int chrmode = NO ;
-static int chimpmode = NO ;
-static int pordercheck = YES ;
-static int snpordered ;
-// fails if packed and out of order
-
-
-SNPDATA *tsdpt ;
-
-/* local function prototypes */
-
-int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) ;
-
-void freeped() ;
-
-static char x2base(int x) ;
-static void gtox(int g, char *cvals, int *p1, int *p2) ;
-
-int ancval(int x) ;
-static int setskipit(char *sx) ; // ignore lines in snp, map files
-int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash) ;
-
-/* ---------------------------------------------------------------------------------------------------- */
-
-void clearsnpord()
-{
-
- free(snpord) ;
- snpord = NULL ;
- numsnpord = 0 ;
-
-}
-int getsnps(char *snpfname, SNP ***snpmarkpt, double spacing,
- char *badsnpname, int *numignore, int numrisks) {
- // returns number of SNPS
- // numrisks
- /* read file of real SNPS store in temporary structure */
-
- SNPDATA **snpraw, *sdpt ;
- static SNP **snpmarkers ;
- SNP *cupt ;
- int **snppos ;
- int nreal, nfake, numsnps = 0, i, t, j ;
- int *snpindx ;
- double xspace ;
- int failx = 0 ;
-
- if (snpfname == NULL) fatalx("(getsnps) null snpname") ;
- xspace = spacing ;
- nreal = getsizex(snpfname) ;
- if (nreal <= 0) fatalx("no snps found: snpfname: %s\n", snpfname) ;
- ZALLOC(snpraw, nreal, SNPDATA *) ;
-
- if (snpord == NULL) {
- ZALLOC(snpord, nreal, int) ;
- ivclear(snpord, -1, nreal) ;
- numsnpord = nreal ;
- }
- for (i=0; i<nreal ; i++) {
- ZALLOC(snpraw[i], 1, SNPDATA) ;
- cclear(snpraw[i] -> cchrom, CNULL, 7) ;
- snpraw[i] -> inputrow = -1 ;
- snpraw[i] -> alleles[0] = '1' ;
- snpraw[i] -> alleles[1] = '2' ;
- }
- nreal = readsnpdata(snpraw, snpfname) ;
- dobadsnps(snpraw, nreal, badsnpname) ;
-
- ZALLOC(snppos, nreal, int *) ;
- for (i=0; i<nreal; i++) {
- ZALLOC(snppos[i], 3, int) ;
- }
-
- for (i=0; i<nreal ; i++) {
- sdpt = snpraw[i] ;
- snppos[i][0] = sdpt -> chrom ;
- if ((sdpt->ignore) && (plinkinputmode)) snppos[i][0] = 99 ;
- t = snppos[i][1] = nnint((sdpt -> gpos)*GDISMUL) ;
- snppos[i][2] = nnint(sdpt -> ppos) ;
- // sdpt -> gpos = ((double) t)/ GDISMUL ;
- }
-
-/**
- for (i=nreal-10; i<nreal; i++) {
- printf("zzyy: %d ", i) ; printimat(snppos[i], 1, 3) ;
- }
-*/
-
- ZALLOC(snpindx, nreal, int) ;
- ipsortit(snppos, snpindx, nreal, 3) ;
-
- snpordered = YES;
- for (i=0; i<nreal; ++i) {
- j = snpindx[i] ;
- if (j != i) {
- snpordered = NO ;
- ++failx ;
- if (failx < 10) {
- printf("snp order check fail (gdis order != physdis order): %s (processing continues)", snpfname) ; printimat(snppos[j], 1, 3) ;
- }
- }
- }
-
-/**
- for (i=nreal-10; i<nreal; i++) {
- printf("zzyy2: %d ", i) ; printimat(snppos[i], 1, 3) ;
- }
-*/
-
- if ((usecm) && (xspace>0.5)) {
- printf("*** warning fake spacing given in cM\n") ;
- xspace /= 100.0 ;
- }
-
- // get number of fakes
-
- nfake = numfakes(snpraw, snpindx, nreal, xspace) ;
- numsnps = nreal + nfake ;
-
- tempnum = numsnps ;
- tempfake = nfake ;
-
- // allocate storage
-
- ZALLOC(snpmarkers, numsnps, SNP *) ;
- for (i=0; i<numsnps; i++) {
- ZALLOC(snpmarkers[i], 1, SNP) ;
- cupt = snpmarkers[i] ;
- clearsnp(cupt) ;
- ZALLOC(cupt -> modelscores, numrisks, double) ;
- ZALLOC(cupt -> totmodelscores, numrisks, double) ;
- }
- tsdpt = snpraw[0] ;
- *snpmarkpt = snpmarkers ;
- numsnps = loadsnps(snpmarkers, snpraw, snpindx, nreal, xspace, numignore) ;
-
-/**
- for (i=numsnps-10; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- printf("zzyy3: %d %d %12.0f\n", i, cupt -> chrom, cupt -> physpos) ;
- }
-*/
-
-
-
-
- // and free up temporary storage
- for (i=0; i<nreal ; i++) {
- free(snpraw[i]) ;
- free(snppos[i]) ;
- }
- free(snpraw) ;
- free(snppos) ;
- free(snpindx);
-
- /* printf("numsnps: %d\n", numsnps) ; */
-
- /*
- if (snpord != NULL) {
- printimat(snpord, 1, MIN(100, numsnps)) ;
- }
- */
- cupt = snpmarkers[0] ;
- if (isnumword(cupt -> ID)) printf("*** warning: first snp %s is number. perhaps you are using .map format\n", cupt -> ID) ;
-
- return numsnps ;
-}
-
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int getsizex(char *fname) {
- char line[MAXSTR+1], c ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0 ;
- int skipit ;
- int len ;
-
- FILE *fff ;
- openit(fname, &fff, "r") ;
- line[MAXSTR] = '\0' ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ; // comment line
- if (skipit == NO) {
- ++num ;
- }
-
- // now flush the rest of the line if necessary.
- len = strlen(line) ;
- c = line[len-1] ;
- if (c != '\n') {
- while ((c = fgetc(fff)) != EOF) {
- if (c == '\n') break ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- fflush(stdout) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ismapfile(char *fname) {
- // PLINK map file ?
- // just look at file name (perhaps should look at format)
-
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
-
- if (strcmp(sx, ".map") == 0) return YES ;
- if (strcmp(sx, ".bim") == 0) return YES ;
-
- if (len<7) return NO ;
- sx = fname+len-7 ;
- if (strcmp(sx, ".pedsnp") == 0) return YES ;
-
- return NO ;
-
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ispedfile(char *fname) {
- // PLINK ped file ?
- // just look at file name (perhaps should look at format)
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
-
- if (strcmp(sx, ".ped") == 0) return YES ;
- if (strcmp(sx, ".fam") == 0) return YES ;
-
- if (len<7) return NO ;
- sx = fname+len-7 ;
- if (strcmp(sx, ".pedind") == 0) return YES ;
-
- return NO ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int isbedfile(char *fname) {
- // PLINK ped file ?
- // just look at file name (perhaps should look at format)
-
- char *sx ;
- int len ;
- len = strlen(fname) ;
- if (len<4) return NO ;
- sx = fname+len-4 ;
-
- if (strcmp(sx, ".bed") == 0) return YES ;
- return NO ;
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readsnpdata(SNPDATA **snpraw, char *fname) {
- char line[LONGSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- int skipit ;
- SNPDATA *sdpt ;
-
- double maxg = -9999.0 ;
-
- FILE *fff ;
- int chrom ;
- int nbad = 0 ;
-
- plinkinputmode = NO ;
- // if this is a PLINK file, call PLINK input routine
- if (ismapfile (fname)) {
- plinkinputmode = YES ;
- return readsnpmapdata(snpraw, fname) ;
- }
- usecm = NO ;
-
- vclear(maxgpos, -9999.0, MAXCH) ;
- openit(fname, &fff, "r") ;
- while (fgets(line, LONGSTR, fff) != NULL) {
-
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("(readsnpdata) bad line: %s\n",line) ;
- sdpt = snpraw[num] ;
- sdpt -> inputrow = num ;
-
- if (strlen(spt[0]) >= IDSIZE) fatalx("ID too long\n", spt[0]) ;
- strcpy(sdpt->ID, spt[0]) ;
-
- sdpt -> chrom = chrom = str2chrom(spt[1]) ;
- strncpy(sdpt -> cchrom, spt[1], 6) ;
-
- if ((chrom>=MAXCH) || (chrom <=0)) {
- if (nbad<10) printf("warning: bad chrom: %s", line) ;
- ++nbad ;
-
- sdpt -> chrom = MIN(chrom, BADCHROM) ;
- sdpt -> chrom = MAX(chrom, 0) ;
- sdpt -> ignore = YES ;
- }
-
- // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
- // any genetic position is greater than 100
-
- sdpt -> gpos = atof(spt[2]) ;
- if (sdpt->gpos > 100) {
- if (sdpt->gpos > 1.0e6)
- fatalx("absurd genetic distance:\n%s\n", line) ;
- if (!usecm) {
- printf("*** warning. genetic distances are in cM not Morgans\n") ;
- printf("%s\n",line) ;
- }
- usecm = YES ; // set flag to connvert to Morgans
- }
-
- maxgpos[chrom] = MAX(maxgpos[chrom], sdpt -> gpos) ;
- maxg = MAX(maxg, maxgpos[chrom]) ;
-
- setsdpos(sdpt, atoi(spt[3])) ;
- if (nsplit<8) {
- ivzero(sdpt->nn,4) ;
- if (nsplit==6) {
- sx = spt[4] ; sdpt -> alleles[0] = toupper(sx[0]) ;
- sx = spt[5] ; sdpt -> alleles[1] = toupper(sx[0]) ;
- }
- }
- else { // QUESTION: when does a SNP file have more than seven columns?
- for (k=0; k<4; k++) {
- sdpt->nn[k] = atoi(spt[4+k]) ;
- }
- if (nsplit==10) {
- sx = spt[8] ; sdpt -> alleles[0] = toupper(sx[0]) ;
- sx = spt[9] ; sdpt -> alleles[1] = toupper(sx[0]) ;
- }
- }
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- } // elihw
-
- // if all genetic positions are set to zero, set from physical position
- if (maxg<=0.00001) {
- printf("%s: genetic distance set from physical distance\n", fname) ;
- usecm = NO ;
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos = 1.0e-8 * snpraw[k] -> ppos ;
- }
- }
-
- // convert to Morgans
- if (usecm) {
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos /= 100.0 ;
- }
- }
-
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readsnpmapdata(SNPDATA **snpraw, char *fname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, t ;
- int skipit, len ;
- SNPDATA *sdpt ;
- int nbad = 0 ;
-
- FILE *fff ;
- int chrom ;
- double maxg = -9999.0 ;
-
- vclear(maxgpos, -9999.0, MAXCH) ;
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("(readsnpmapdata) bad line: %s\n",line) ;
- sdpt = snpraw[num] ;
- if (strlen(spt[1]) >= IDSIZE) fatalx("ID too long\n", spt[1]) ;
- strcpy(sdpt->ID, spt[1]) ;
-
- if (nsplit >=6 ) { // alleles in .map file are optional
- sx = spt[4] ; sdpt -> alleles[0] = sx[0] ;
- sx = spt[5] ; sdpt -> alleles[1] = sx[0] ;
- if (sdpt->alleles[0] == '0') sdpt -> alleles[0] = 'X' ; // unknown
- if (sdpt->alleles[1] == '0') sdpt -> alleles[1] = 'X' ;
- }
- else {
- cclear((unsigned char *) sdpt -> alleles, CNULL, 2) ;
- }
-
- sx = spt[0] ;
- sdpt -> chrom = chrom = str2chrom(sx) ;
- strncpy(sdpt -> cchrom, sx, 6) ;
-
- if ((chrom>=MAXCH) || (chrom <=0)) {
- if (nbad<10) printf("warning (mapfile): bad chrom: %s", line) ;
- ++nbad ;
-
- sdpt -> chrom = MIN(chrom, BADCHROM) ;
- sdpt -> chrom = MAX(chrom, 0) ;
- sdpt -> chrom = 99 ;
- strcpy(sdpt -> cchrom, "99") ;
- sdpt -> ignore = YES ;
- }
-
- // the genetic positions will be converted to Morgans (assumed to be in cM) if and only if
- // any genetic position is greater than 100
-
- sdpt -> gpos = atof(spt[2]) ;
- if (sdpt->gpos > 100) {
- if (sdpt->gpos > 1.0e6)
- fatalx("absurd genetic distance:\n%s\n", line) ;
- if (!usecm) {
- printf("*** warning. genetic distances are in cM not Morgans\n") ;
- printf("%s\n",line) ;
- }
- usecm = YES ;
- }
- maxgpos[chrom] = MAX(maxgpos[chrom], sdpt -> gpos) ;
- maxg = MAX(maxg, maxgpos[chrom]) ;
- sdpt -> ppos = atof(spt[3]) ;
- if (nsplit<8) {
- ivzero(sdpt->nn,4) ;
- }
- else {
- for (k=0; k<4; k++) {
- sdpt->nn[k] = atoi(spt[4+k]) ;
- }
- }
- sdpt -> inputrow = num ;
-// printf("zz %d %d %s %12.0f\n", num, sdpt -> chrom, sdpt -> ID, sdpt -> ppos) ;
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
-
- if (maxg<=0.00001) {
- printf("genetic distance set from physical distance\n") ;
- usecm = NO ;
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos = 1.0e-8 * snpraw[k] -> ppos ;
- }
- }
-
- if (usecm) {
- for (k=0; k<num ; ++k) {
- snpraw[k] -> gpos /= 100.0 ;
- }
- }
-
- if (snpord == NULL) {
- ZALLOC(snpord, num, int) ;
- ivclear(snpord, -1, num) ;
- numsnpord = num ;
- }
-
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing) {
-
- // it seems better for this internal routine
- // to use the precomputed values
-
- int nignore, numsnps;
- int nfake = 0, i, k, indx ;
- int num=0;
- SNP *cupt ;
- SNPDATA *sdpt ;
- char *sname ;
- int *sp ;
- int xc = 0, chrom ;
- double fakedis, realdis ; // gpos for fake marker
- double yf, yr ;
- double physpos ;
-
- if (spacing <= 0.0) fakedis = 1.0e20 ;
-
- for (k=0; k< nreal ; k++) {
-
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
-
- chrom = sdpt -> chrom ;
- realdis = sdpt -> gpos ;
-
- if (chrom != xc) {
- fakedis = nextmesh(realdis, spacing) ;
- xc = chrom ;
- }
- while (fakedis<realdis) {
- fakedis += spacing ;
- ++nfake ;
- }
- }
-
- // nfake is number of multiples of fakedis in chromosome
-
- return nfake ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-double nextmesh(double val, double spacing) {
- double y ;
-
- if (spacing==0.0) return 1.0e8 ;
- y = ceil(val/spacing)*spacing ;
- if (y<val) y += spacing ;
- return y ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-/*! \fn int loadsnps(SNP **snpm, SNPDATA **snpraw,
- int *snpindx, int nreal, double spacing, int *numignore)
- \brief Store raw SNP data in final array of type SNP *
- \param snpm Pointer to array of type SNP * in which to store data
- \param snpraw Pointer to array of type SNPDATA * in which preliminary data was stored
- \param snpindx On entry, kth element of snpindx is index of the kth SNP in snpraw (This is not
- the same as the value k itself if the SNPs were out of order in the file.)
- \param nreal Number of SNPs stored in snpraw
- \param spacing Maximum spacing between SNPs (not relevant to EIGENSOFT)
- \param numignore Return number of SNPs to ignore here
-*/
-
-
-int loadsnps(SNP **snpm, SNPDATA **snpraw,
- int *snpindx, int nreal, double spacing, int *numignore) {
-
- // snppos, snpindx could be recalculated but
- // it seems better for this internal routine
- // to use the precomputed values
- // do NOT call externally
-
- int nignore, numsnps;
- int nfake = 0, i, k, indx ;
- int num=0, tnum;
- SNP *cupt= NULL, *lastcupt = NULL, *tcupt ;
- SNPDATA *sdpt ;
- char *sname ;
- int *sp ;
- int xc = 0, chrom ;
- double fakedis, realdis, xrealdis ; // gpos for fake marker
- double yf, yr ;
- double physpos ;
- double xl, xr, xmid, al, ar, fraw ;
- double y ;
- int nn[2], n0, n1 ;
- int cnum, t ;
- int inputrow, chimpfudge, xchimpfudge ;
- int ischimp = NO ;
- char ss[6] ;
-
- if (spacing <= 0.0) fakedis = 1.0e20 ;
- strcpy(ss, "??") ;
-
- for (k=0; k< nreal ; k++) {
-
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
-
- chrom = sdpt -> chrom ;
-// defensive programming; should not be needed:
- if (sdpt -> cchrom[0] == CNULL) {
- sprintf(sdpt -> cchrom, "%d", chrom) ;
- }
- sname = sdpt -> ID ;
- realdis = sdpt -> gpos ;
- physpos = sdpt -> ppos ;
- inputrow = sdpt -> inputrow ;
- if (sdpt -> chimpfudge) ischimp = YES ;
-
-/**
- if (k>(nreal-10)) {
- printf("zzyy2b %d %d %12.0f %d\n", k, chrom, physpos, inputrow) ;
- }
-*/
-
- t = strcmp(ss, sdpt -> cchrom) ;
- if (t != 0) {
- fakedis = nextmesh(realdis, spacing) ;
- xc = chrom ;
- cnum = 0 ;
- strcpy(ss, sdpt -> cchrom) ;
- }
-
- yf = fakedis ;
- yr = realdis ;
-
- // insert fake SNPs so the distance between SNPs is no greater than spacing
- while (fakedis<realdis) {
-
- if (cnum==0) break ; // first SNP on chromosome
- if (sdpt -> ignore) break ;
-
- if (nfake>=tempfake) fatalx(" too many fake markers (bug) %d %d\n", num, nfake) ;
- if (num>=tempnum) fatalx(" too many markers (bug) %d %d\n", num, nfake) ;
-
- cupt = snpm[num] ;
- if (cupt == NULL) fatalx("bad loadsnps\n") ;
- sprintf(cupt -> ID, "fake-%d:%d", xc, nfake) ;
- cupt -> estgenpos = cupt -> genpos = fakedis ;
- tcupt = lastcupt ;
- for (;;) {
- xl = tcupt -> genpos ;
- if (xl < fakedis) break ;
- tnum = tcupt -> markernum ;
- --tnum ;
- if (tnum<0) fatalx("verybadbug\n") ;
- tcupt = snpm[tnum] ;
- if (tcupt -> chrom != chrom) fatalx("badbug\n") ;
- }
- al = tcupt -> physpos ;
- xr = realdis ; ;
- ar = physpos ;
- y= cupt -> physpos = interp(xl, xr, fakedis, al, ar) ;
- if (chrom == -199) {
- printf("zzinterp %12.6f %12.6f %12.6f %12.0f %12.0f %12.6f\n",
- xl, xr, fakedis, al, ar, y) ;
- }
- cupt -> markernum = num ;
- cupt -> isfake = YES ;
- cupt -> chrom = xc ;
- strncpy(cupt -> cchrom, ss, 6) ;
- fakedis += spacing ;
- ++num ;
- ++nfake ;
- }
-
- cupt = snpm[num] ;
- if (cupt == NULL) fatalx("bad loadsnps\n") ;
- strcpy(cupt -> ID, sname) ;
- sdpt -> cuptnum = num ;
- cupt -> estgenpos = cupt -> genpos = realdis ;
- cupt -> physpos = physpos ;
- cupt -> markernum = num ;
- cupt -> isfake = NO ;
- cupt -> ignore = sdpt -> ignore ;
- // if ((cupt -> ignore == NO) && (cupt -> isfake == NO))
- if ((cupt -> isfake == NO)) {
- lastcupt = cupt ;
- ++cnum ;
- }
- cupt -> isrfake = sdpt -> isrfake ;
- cupt -> chrom = xc ;
- strncpy(cupt -> cchrom, ss, 6) ;
- cupt -> tagnumber = inputrow ; // just used for pedfile
- if (inputrow >=0) {
- if (inputrow >= numsnpord) fatalx("snpord overflow\n") ;
- snpord[inputrow] = num ;
- }
-
- n0 = sdpt->nn[0] ;
- n1 = sdpt->nn[1] ;
- fraw = mknn(nn, n0, n1) ;
- copyiarr(nn, cupt->af_nn, 2) ;
- cupt -> aftrue = cupt -> af_freq = fraw ;
- cupt -> aa_aftrue = cupt -> aa_af_freq = fraw ;
-
- if (sdpt -> alleles != NULL) {
- cupt -> alleles[0] = sdpt -> alleles[0] ;
- cupt -> alleles[1] = sdpt -> alleles[1] ;
- }
- else {
- cupt -> alleles[0] = '1' ;
- cupt -> alleles[1] = '2' ;
- }
-
- n0 = sdpt->nn[2] ;
- n1 = sdpt->nn[3] ;
- fraw = mknn(nn, n0, n1) ;
- copyiarr(nn, cupt->cauc_nn, 2) ;
- cupt -> cftrue = cupt -> cauc_freq = fraw ;
- cupt -> aa_cftrue = cupt -> aa_cauc_freq = fraw ;
- ++num ;
- }
-
- // now make list of ignored snps used by loadgeno for check
- numsnps = num ;
- for (k=0; k< nreal ; k++) {
- indx = snpindx[k] ;
- sdpt = snpraw[indx] ;
- if (sdpt->ignore == NO) continue ;
- inputrow = sdpt -> inputrow ;
- chrom = sdpt -> chrom ;
- sname = sdpt -> ID ;
- realdis = sdpt -> gpos ;
- physpos = sdpt -> ppos ;
- cupt = snpm[sdpt -> cuptnum] ;
- cupt -> tagnumber = inputrow ; // just used for pedfile
- /*
- strncpy(cupt -> ID, sname, IDSIZE-1) ;
- cupt -> genpos = realdis ;
- cupt -> physpos = physpos ;
- cupt -> markernum = num ;
- cupt -> isfake = NO ;
- cupt -> ignore = YES ;
- cupt -> chrom = chrom ;
- */
- ++num ;
- }
- nignore = 0 ;
- for (k=0; k<numsnps; ++k) {
- cupt = snpm[k] ;
- if (ischimp && (cupt -> chrom == 2)) cupt -> chimpfudge = YES ;
- if (cupt -> ignore) ++nignore ;
- }
- *numignore = nignore ;
- return numsnps ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-double interp (double l, double r, double x, double al, double ar) {
- // linearly interp ;
- double y, y1, y2 ;
- y = (r-l) ;
- if (y==0.0) return 0.5*(al+ar) ;
- y1 = (r-x)/y ;
- y2 = (x-l)/y ;
- return y1*al +y2*ar ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int getindivs(char *indivfname, Indiv ***indmarkpt) {
- static Indiv **indivmarkers ;
- int nindiv, i ;
-
- if (indivfname == NULL) fatalx("(getindivs) NULL indivfname\n") ;
- nindiv = getsizex(indivfname) ;
- if (nindiv <= 0) fatalx("no indivs found: indivname: %s\n", indivfname) ;
- ZALLOC(indivmarkers, nindiv, Indiv *) ;
-
- for (i=0; i<nindiv; i++) {
- ZALLOC(indivmarkers[i], 1, Indiv) ;
- }
- clearind(indivmarkers, nindiv) ;
- *indmarkpt = indivmarkers ;
- readinddata(indivmarkers, indivfname) ;
- return nindiv ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readinddata(Indiv **indivmarkers, char *fname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- int skipit ;
- Indiv *indx ;
-
- FILE *fff ;
-
- // Call routine to read PLINK format file
- if (ispedfile(fname)) {
- plinkinputmode = YES ;
- return readindpeddata(indivmarkers, fname) ;
- }
-
- // Read ANCESTRYMAP/EIGENSTRAT format individual file
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<3) fatalx("%s bad line: %s", fname, line) ;
- indx = indivmarkers[num] ;
- if (strlen(sx)>=IDSIZE) fatalx("ID too long: %s\n", sx) ;
- strcpy(indx->ID, sx) ;
- indx -> idnum = num ;
- sx = spt[1] ;
- indx -> gender = sx[0] ;
- indx -> affstatus = indx -> ignore = NO ;
- sx = spt[2] ;
- if (strcmp(sx, "Ignore") == 0) indx->ignore = YES ;
- if ((qtmode) && (!indx->ignore)) { // store quantitative phenotype in qval
- indx -> egroup = strdup("Case") ;
- indx -> qval = indx -> rawqval = atof(sx) ;
- }
- else {
- indx -> egroup = strdup(sx) ; // store discrete phenotype in egroup
- }
- // affstatus set by setstatus
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readindpeddata(Indiv **indivmarkers, char *fname) {
- char *line ;
- char *spt[MAXFF], *sx, *sx0, gender ;
- int nsplit, num=0, k, i ;
- int skipit ;
- Indiv *indx ;
- int nindiv ;
- int maxnsplit = 0 ;
- char nnbuff[IDSIZE] ;
- int nok = 0 ;
-
- FILE *fff ;
-
- maxgenolinelength = maxlinelength(fname) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
- openit(fname, &fff, "r") ;
-
- while (fgets(line, maxgenolinelength, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx0 = sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- if (skipit == NO) {
- if (nsplit<6) fatalx("%s bad line: %s", fname, line) ;
- indx = indivmarkers[num] ;
- if (strlen(sx)>=IDSIZE) fatalx("ID too long: %s\n", sx) ;
- maxnsplit = MAX(maxnsplit, nsplit) ;
-
- sx = spt[1] ;
- pedname(nnbuff, sx0, sx) ;
- strcpy(indx->ID, nnbuff) ;
- indx -> idnum = num ;
- sx = spt[4] ;
- k = atoi(sx) ;
- gender = 'U' ;
- if (k==1) gender = 'M' ;
- if (k==2) gender = 'F' ;
- indx -> gender = gender ;
- indx -> affstatus = indx -> ignore = NO ;
-
- sx = spt[5] ;
- if (qtmode) {
- indx -> egroup = strdup("Case") ;
- indx -> qval = indx -> rawqval = atof(sx) ;
- }
- else {
- k = 99 ;
- if (strcmp(sx, "-9") == 0) k = -9 ;
- if (strcmp(sx, "9") == 0) k = 9 ;
- if (strcmp(sx, "0") == 0) k = 0 ;
- if ((pedignore == NO) && (k==0)) k = 3 ;
- if (strcmp(sx, "1") == 0) k = 1 ;
- if (strcmp(sx, "2") == 0) k = 2 ;
- switch (k) {
- case 9:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case -9:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case 0:
- indx -> ignore = YES ;
- printf("%s ignored\n", indx -> ID) ;
- break ;
- case 1:
- indx -> egroup = strdup("Control") ;
- break ;
- case 2:
- indx -> egroup = strdup("Case") ;
- break ;
- case 3:
- indx -> egroup = strdup("???") ;
- break ;
- default:
- indx -> egroup = strdup(sx) ;
- }
- }
-
- // affstatus set by setstatus
- if (indx -> ignore == NO) ++nok;
- ++num ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
-
- if (nok == 0) {
- printf("all individuals set ignore. Likely input problem (col 6)\n") ;
- printf("resetting all individual...\n") ;
- for (i=0; i<num; i++) {
- indx = indivmarkers[i] ;
- indx -> ignore = NO ;
- indx -> egroup = strdup("???") ;
- }
- }
-
- if (maxnsplit<8) maxgenolinelength = -1 ;
- free(line) ;
-
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void pedname(char *cbuff, char *sx0, char *sx1) {
- int l0 , l1, ll ;
-
- l0 = strlen(sx0) ;
- l1 = strlen(sx1) ;
- ll = l0 +l1 + 1 ;
- if (familynames == NO) ll = l1 ;
- if (ll>=IDSIZE) {
- fatalx("idnames too long %s %s ll: %d limit: %d\n", sx0, sx1, ll, IDSIZE-1) ;
- }
- if (familynames == YES) { // prepend family name to individual name
- strcpy(cbuff, sx0) ;
- cbuff[l0] = ':' ;
- strcpy(cbuff+l0+1, sx1) ;
- return ;
- }
- strcpy(cbuff, sx1) ;
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname) {
- // warning printed if theta/lambda not in file
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind, i ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
- int *xcheck ;
-
- FILE *fff ;
- ZALLOC(xcheck, numindivs, int) ;
- openit(inddataname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (strcmp(sx, "Indiv_Index") == 0) {
- // hack. thetafile should be output with leading ##
- freeup(spt, nsplit) ;
- continue ;
- }
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<8) fatalx("%s bad line: %s", inddataname, line) ;
- sx = spt[1] ;
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readtldata) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
-
- indx -> theta_mode = atof(spt[3]) ;
- indx -> lambda_mode = atof(spt[7]) ;
- indx -> Xtheta_mode = atof(spt[5]) ;
- indx -> Xlambda_mode = atof(spt[9]) ;
- xcheck[ind] = 1 ;
-
- freeup(spt, nsplit) ;
- continue ;
- }
- for (i=0; i<numindivs; ++i) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- if (xcheck[i] == 1) continue ;
- printf("*** warning (readtldata) ") ;
- printf("%s not found in tlname file", indx -> ID) ;
- printnl() ;
- }
-
- free (xcheck) ;
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readfreqdata(SNP **snpm, int numsnps, char *inddataname) {
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- SNP *cupt ;
-
- FILE *fff ;
- openit(inddataname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (nsplit<6) fatalx("%s bad line: %s", inddataname, line) ;
- sx = spt[2] ;
- ind = snpindex(snpm, numsnps, sx) ;
- if (ind<0) fatalx("(readfreqdata) snp %s not found \n", sx) ;
- cupt = snpm[ind] ;
- cupt -> aa_af_freq = cupt -> af_freq = atof(spt[3]) ;
- cupt -> aa_cauc_freq = cupt -> cauc_freq = atof(spt[5]) ;
-
- freeup(spt, nsplit) ;
- ++num ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int setstatus(Indiv **indm, int numindivs, char *smatch) {
- // return number set
- // smatch = NULL => set everything
- return setstatusv(indm, numindivs, smatch, YES) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int setstatusv(Indiv **indm, int numindivs, char *smatch, int val) {
- // return number set
- // smatch = NULL => set everything
- int i, n=0 ;
- Indiv *indx ;
- char *sx ;
- for (i=0; i<numindivs; i++) {
- indx = indm[i] ;
- if (indx -> ignore) continue ;
- sx = indx -> egroup ;
- if (smatch == NULL) {
- ++n ;
- indx->affstatus = val ;
- continue ;
- }
- if (strcmp(sx, smatch) == 0) {
- ++n ;
- indx->affstatus += val ;
- }
- if (indx -> affstatus >1) fatalx("aff2bug\n") ;
- }
- return n ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) {
- // read genofile. Use hashtable to improve search
- // if genofile is gzipped decompress to trashdir
- char *gname, *genotmp = NULL ;
- ENTRY *hashlist, *iteml ;
- ENTRY item1 ;
- int k, num, indiv, lgt ;
- int val ;
- void *basept = 0 ;
- int bigoff ;
- int tcheck ;
-
- // we use a trick: want to store k
- // store basept + k instead
- // basept + k + bigoff for individual ID
-
- SNP *cupt ;
- Indiv *indx ;
-
- char line[MAXSTR], cmd[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, nsnp ;
- int skipit, kret, tpackmode, teigenstratmode ;
-
- FILE *fff ;
- int gnlen, ngenos=0 ;
-
- double y ;
- char *pbuff ;
-
- item1.key = NULL ;
- item1.data = NULL ;
-
- if (genoname == NULL) fatalx("(getgenos) NULL genoname\n") ;
- gname = genoname ;
- gnlen = strlen(genoname) ;
-
- // Unzip file if necessary
- if (strcmp(genoname+gnlen-3, ".gz") == 0) {
- makedir(trashdir) ;
- sprintf(line, "%s/genotmp:%d", trashdir, getpid()) ;
- genotmp = strdup(line) ;
- sprintf(cmd, "gunzip -c %s > %s", genoname, genotmp) ;
- printf("unzip cmd: %s\n", cmd) ;
- system (cmd) ;
- kret = system (cmd) ;
- if (kret<0) {
- perror("gunzip failed\n") ;
- fatalx("gunzip failed... probably out of disk space\n") ;
- }
- printf("geno file unzipped\n") ;
- gname = genotmp ;
- }
-
- // Enforce data size limits
- tcheck = checksize(numsnps, numindivs, outputmode) ;
- if (tcheck == -2) fatalx("Data sets with more than 8 billion genotypes are not permitted\n") ;
- if (tcheck == -1) fatalx("Output files of size >2GB are not permitted: use a more compact output data format. Also see documentation of chrom, badsnpname and checksizemode parameters.\n") ;
-
- // Call routine to read PLINK format unpacked genotype file
- if (ispedfile(gname)) {
-
- if (snpord == NULL) fatalx("snpord not allocated (no map file ?)") ;
- getpedgenos(genoname, snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
- freeped() ;
- return numsnps*numindivs ;
- }
-
- // Call routine to read PLINK format packed genotype file
- if (isbedfile(gname)) {
- return getbedgenos(genoname, snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
- }
-
- // Check whether file is packed ANCESTRYMAP format (packed EIGENSTRAT does not exist)
- tpackmode = ispack(gname) ;
- nsnp = numsnps ;
-
- // Call routine to read packed ANCESTRYMAP format
- if (tpackmode) {
- inpack(gname, snpmarkers, indivmarkers, nsnp, numindivs) ;
- for (k=0; k<nsnp; k++) {
- cupt = snpmarkers[k] ;
- if (cupt -> ignore) continue ;
- if ((cupt -> isfake) && (!(cupt -> isrfake))) continue ;
- cupt -> ngtypes = numindivs ;
- if (cupt -> gtypes == NULL) ZALLOC(cupt -> gtypes, 1, int) ;
- }
- packmode = YES ;
- return nsnp*numindivs ;
- }
-
- teigenstratmode = iseigenstrat(gname) ;
-
- // Call routine to read EIGENSTRAT format
- if (teigenstratmode) {
- packmode = YES ;
- ineigenstrat(gname, snpmarkers, indivmarkers, nsnp, numindivs) ;
- freeped() ;
- return nsnp*numindivs ;
- }
-
-
- // (If execution reaches here, the file is unpacked ANCESTRYMAP format)
-
- // rlen is number of bytes needed to store each SNP's genotype data
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- packlen = rlen*numsnps ;
- if (packlen<0) fatalx("yuckk\n") ;
- if (packmode) {
- ZALLOC(packgenos, packlen, char) ;
- pbuff = packgenos ;
- clearepath(packgenos) ;
- }
-
- // instantiate hash table
- num = nsnp + numindivs ;
- xhcreate(5*num) ;
- ZALLOC(hashlist, num, ENTRY) ;
- bigoff = nsnp + 100 ;
-
- // hash SNPs (key=name, value=index in snpmarkers)
- for (k=0; k<nsnp; k++) {
- cupt = snpmarkers[k] ;
- if ((cupt -> isfake) && (!(cupt -> isrfake))) continue ;
- iteml = hashlist+k ;
- iteml -> key = cupt->ID ;
- iteml -> data = basept +k ;
- if (xhsearch(*iteml, FIND) != NULL)
- fatalx("duplicate ID: %s\n", iteml -> key) ;
- (void) xhsearch(*iteml, ENTER) ;
- }
-
- // hash individuals (key=name, value=index in indivmarkers)
- for (k=0; k<numindivs; k++) {
-
- indx = indivmarkers[k] ;
- iteml = hashlist+numsnps+k ;
- iteml -> key = indx->ID ;
- iteml -> data = basept+k+bigoff ;
- if (xhsearch(*iteml, FIND) != NULL)
- fatalx("duplicate ID: %s\n", iteml -> key);
- (void) xhsearch(*iteml, ENTER) ;
- }
-
- // read genotype file
- openit(gname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<3) fatalx("bad geno line. missing field?\n", line) ;
-
- // Look up SNP and individual indices in hash table
- item1.key = spt[0] ;
- iteml = xhsearch(item1, FIND) ;
- if (iteml == NULL) {
- fatalx("(genotypes) bad ID (SNP): %s\n", line) ;
- }
- k = (int) (iteml->data - basept) ;
-
- if (k>=numsnps) {
- fatalx("bad genotype line: `snp' may be Indiv Id\n%s\n", line) ;
- }
-
- cupt = snpmarkers[k] ;
- if (cupt -> ignore) {
- freeup(spt, nsplit) ;
- continue ;
- }
- item1.key = spt[1] ;
- iteml = xhsearch(item1, FIND) ;
- if (iteml == NULL) {
- fatalx("(genotypes) bad ID: (Indiv) %s\n", line) ;
- }
- indiv = (int) (iteml->data - basept) ;
- indiv -= bigoff ;
- val = atoi(spt[2]) ;
-
- indx = indivmarkers[indiv] ;
- if (indx->ignore) val = -1 ;
- if (checkxval(cupt, indx, val) == NO) val = -1 ;
- if (val>2) {
- printf("*** warning invalid genotype: %s %s %d\n",
- cupt -> ID, indx -> ID, val) ;
- val = -1 ;
- }
-
- if (cupt -> ngtypes == 0) {
-
- // If this is the first datum for this SNP, initialize
- // Set cupt->puff to point to the SNP's data in the genotype array.
- // Set cupt->gtypes to the number of individuals stored in the genotype.
-
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numindivs, int) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numindivs ;
- for (k=0; k<numindivs; ++k) {
- putgtypes(cupt, k, -1) ; // initialize all individuals to "missing data"
- }
- }
- putgtypes(cupt, indiv, val) ; // store this individual's genotype at this SNP
- ++ngenos ;
- }
- freeup(spt, nsplit) ;
- }
- fclose(fff) ;
-
- // destroy hash table
- free(hashlist) ;
- xhdestroy() ;
-
-
- // if this is a temporary file (gunzipped), delete it
- if (genotmp != NULL) {
- unlink(gname) ;
- }
- /* printf("genotype file processed\n") ; */
- freeped() ;
- return ngenos ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void freeped() {
- // destructor for snpord
- if (snpord == NULL) return ;
- if (dofreeped == NO) return ;
- free(snpord) ;
- snpord = NULL ;
- numsnpord = 0 ;
- maxgenolinelength = -1 ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int checkxval(SNP *cupt, Indiv *indx, int val) {
- // check Male X marker not het
- if (cupt -> chrom != numchrom+1) return YES ;
- if (indx -> gender != 'M') return YES ;
- if (val != 1) return YES ;
- if (malexhet) return YES ;
- return NO;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void clearsnp(SNP *cupt) {
-
- cupt -> af_freq =
- cupt -> cauc_freq = -1 ;
- cupt -> aa_af_freq =
- cupt -> aa_cauc_freq = -1 ;
- cupt -> estgenpos = 0 ;
- cupt -> genpos = 0 ;
- cupt -> physpos = 0 ;
- cupt -> ngtypes = 0 ;
- cupt -> pbuff = NULL ;
- cupt -> ebuff = NULL ;
- cupt -> gtypes = NULL ;
- cupt -> modelscores = NULL ;
- cupt -> totmodelscores = NULL ;
- cupt -> score = cupt -> weight = 0.0 ;
- cupt -> isfake = NO ;
- cupt -> ignore = NO ;
- cupt -> isrfake = NO ;
- cupt -> estdis = 0 ;
- cupt -> dis = 0 ;
- cupt -> esum = 0 ;
- cupt -> lsum = 0 ;
- cupt -> gpsum = 0 ;
- cupt -> gpnum = 0 ;
- cupt -> pcupt = NULL ;
- cupt -> tagnumber = -1 ;
- cclear(cupt -> cchrom, CNULL, 7) ;
- strcpy(cupt -> cchrom, "") ;
- cupt -> chimpfudge = NO ;
- cclear((unsigned char *) cupt -> alleles, CNULL, 2) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int rmindivs(SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs) {
- // squeeze out ignore
- // dangerous bend. Of course indivmarkers indexing will change
- int n = 0, g, i, k ;
- int x ;
- Indiv *indx ;
- SNP *cupt ;
-
- // n is index of next unused array element
-
- for (k=0; k<numindivs; ++k) {
- if (indivmarkers[k] -> ignore == YES) continue ; // don't store
- if (n==k) { // if no ignored found yet,
- ++n ; // next unused is next element
- continue ; // and no need to copy
- }
-
- // copy k -> n
- indx = indivmarkers[n] ; // if kth element is not ignored, put it
- indivmarkers[n] = indivmarkers[k] ; // into next unused element
- indx -> idnum = n ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> gtypes == NULL) break ;
- if (cupt -> ignore) continue ; // copy only genotypes of non-ignored SNPs
- g = getgtypes(cupt, k) ;
- putgtypes(cupt, n, g) ;
- }
- ++n ;
- }
-
- for (i=0; i<numsnps; i++) { // reset number of individuals
- cupt = snpm[i] ;
- cupt -> ngtypes = n ;
- }
- return n ;
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int rmsnps(SNP **snpm, int numsnps, char *deletesnpoutname) {
-
- int i,x ;
- SNP *cupt ;
- int lastc, chrom ;
-
- freesnpindex() ; // clear hash table
-
- // wipe out fakes not between real markers
- lastc = -1 ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- chrom = cupt -> chrom ;
- if ( (cupt -> isfake) && (chrom != lastc)) {
- cupt -> ignore = YES ; // precedes first real SNP
- logdeletedsnp(cupt->ID,"isfake",deletesnpoutname);
- }
- if (!cupt -> isfake) lastc = chrom ;
- }
-
- lastc = -1 ;
- for (i=numsnps-1; i>=0; i--) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- chrom = cupt -> chrom ;
- if ( (cupt -> isfake) && (chrom != lastc)) {
- cupt -> ignore = YES ; // follows last real SNP
- logdeletedsnp(cupt->ID,"isfake",deletesnpoutname);
- }
- if (!cupt -> isfake) lastc = chrom ;
- }
-
- x = 0 ; // index of next retained SNP in the array
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) {
- freecupt(&cupt) ;
- continue ;
- }
- snpm[x] = snpm[i] ;
- ++x ;
- }
-
- // reset own-index field
- for (i=0; i<x; i++) {
- cupt = snpm[i] ;
- cupt -> markernum = i ;
- }
-
- return x ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void freecupt(SNP **cuppt) {
- SNP *cupt ;
- cupt = *cuppt ;
- if (cupt -> modelscores != NULL) {
- free(cupt->modelscores) ;
- }
- if (cupt -> totmodelscores != NULL) {
- free(cupt->totmodelscores) ;
- }
- free(cupt) ;
- cupt = NULL ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void clearind(Indiv **indm, int numind) {
- Indiv *indx ;
- double theta ;
- int i ;
-
- for (i=0; i<numind; i++) {
- indx = indm[i] ;
- indx -> egroup = NULL ;
- indx -> affstatus = indx -> ignore = NO ;
- indx -> gender = 'U' ;
- indx = indm[i] ;
- indx -> Xtheta_mode = indx->theta_mode = a1/(a1+b1) ;
- indx -> Xlambda_mode = indx -> lambda_mode = lp1/lp2 ;
- indx -> thetatrue = -1.0 ; // silly value
- indx -> qval = indx -> rawqval = 0.0 ;
- }
- cleartg(indm, numind) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void cleartg(Indiv **indm, int nind) {
- int i ;
- Indiv *indx ;
-
- for (i=0; i< nind; i++) {
- indx = indm[i] ;
- vzero(indx -> totgamms, 3) ;
- indx -> totscore = 0.0 ;
- }
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-double mknn(int *nn, int n0, int n1) {
- double x ;
- int t ;
-
- nn[0] = n0 + 1 ;
- nn[1] = n1 + 1 ;
-
- // no clipping. (Old code clipped here)
- t = intsum(nn,2) ;
- x = ((double) nn[0]) / (double) t ;
-
- return x ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setug(Indiv **indm, int numind, char gender) {
- Indiv *indx ;
- double theta ;
- int i ;
-
- for (i=0; i<numind; i++) {
- indx = indm[i] ;
- if (indx -> gender == 'U') indx -> gender = gender ;
- }
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname) {
-
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF] ;
- char *ss ;
- int indx, nsplit, n ;
-
- if (badsnpname == NULL) return ;
- openit (badsnpname, &fff, "r") ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit==0) continue ;
- if (spt[0][0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- // look up index in snpraw
- indx = snprawindex(snpraw, nreal, spt[0]) ;
- if (indx >=0) {
- snpraw[indx] -> ignore = YES ;
- if ((nsplit >=2) && (checkfake(spt[1]))) {
- snpraw[indx] -> ignore = NO ;
- snpraw[indx] -> isrfake = YES ;
- }
- }
- freeup(spt, nsplit) ;
- }
- fclose (fff) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int checkfake(char *ss) {
- // yes if string ss is "Fake"
- // ss is overwritten
-
- ss[0] = tolower(ss[0]) ;
- if (strcmp(ss,"fake") == 0) return YES ;
- return NO ;
-
-}
-
-void mkchrom(char *ss, int chrom, double *ppos, int fudge, int chrmode)
-{
- char *sx ;
- int big = 200*1000*1000 ;
-
- sx = ss ;
- if (chrmode) {
- strcpy(ss, "chr") ;
- sx += 3 ;
- }
- if ((chrom != 2) || (fudge == NO)) {
- sprintf(sx, "%d", chrom) ;
- return ;
- }
-
- if (*ppos <= big) {
- sprintf(sx, "2a") ;
- }
-
- if (*ppos > big) {
- sprintf(sx, "2b") ;
- *ppos -= big ;
- }
-
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids) {
-
- int i, chrom ;
- double ppos ;
- SNP *cupt ;
- char ss[10] ;
- FILE *xfile ;
- int numvcase, numvcontrol ;
- char c ;
-
- if ((snpoutfilename != NULL) && (strcmp(snpoutfilename, "NULL") == 0)) return ;
- if (snpoutfilename != NULL) {
- openit(snpoutfilename, &xfile, "w") ;
- }
- else xfile = stdout ;
-
- if( tersemode == NO) {
- fprintf(xfile,"\n");
- fprintf(xfile,"###DETAILS ABOUT THE MARKERS\n");
- fprintf(xfile,"##Gen_Pos: genetic position, Phys_pos: Physical position\n");
- fprintf(xfile,"##Afr_vart: Parental African variant allele count, Afr_ref: Parental African reference allele count\n");
- fprintf(xfile,"##Eur_vart: Parental European variant allele count, Eur:ref:Parental European reference allele count\n");
-
- fprintf(xfile, "\n") ;
- fprintf(xfile,"%20s %5s %10s %18s", "#SNP_Id","Chr_Num","Gen_Pos","Phys_Pos") ;
- fprintf(xfile, " %9s %9s %9s %9s" ,"Afr_vart","Afr_ref","Eur_vart","Eur_ref");
- fprintf(xfile, "\n") ;
- }
- for (i = 0; i <num; ++i) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (!printfake && (ignoresnp(cupt))) continue ;
- if (!printfake && (cupt -> isrfake)) continue ;
- }
-
- ppos = cupt -> physpos ;
-
- mkchrom(ss, cupt -> chrom, &ppos, cupt -> chimpfudge, chrmode) ;
- fprintf(xfile, "%20s %5s ", cupt->ID, ss) ;
-
- if (cupt -> genpos == 0.0) {
- fprintf(xfile, "%15.0f %15.0f", cupt -> genpos, ppos) ;
- }
- else {
- fprintf(xfile, "%15.6f %15.0f", cupt -> genpos, ppos) ;
- }
-
- if (tersemode) {
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- continue ;
- }
-
- fprintf(xfile, " %8d ", cupt -> af_nn[0]) ;
- fprintf(xfile, "%8d ", cupt -> af_nn[1]) ;
- fprintf(xfile, "%8d ", cupt -> cauc_nn[0]) ;
- fprintf(xfile, "%8d", cupt -> cauc_nn[1]) ;
- if (!printvalids) {
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- continue ;
- }
- numvcase = numvalidgtx(indm, cupt, 1) ;
- numvcontrol = numvalidgtx(indm, cupt, 0) ;
- fprintf(xfile, " %6d %6d",numvcase, numvcontrol) ;
- fprintf(xfile, " %d %d %d", cupt -> ignore, cupt -> isfake, cupt -> isrfake) ;
- printalleles(cupt, xfile) ;
- fprintf(xfile, "\n") ;
- }
- if (snpoutfilename != NULL)
- fclose(xfile) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void printalleles(SNP *cupt, FILE *fff) {
- char c ;
- if ((c = cupt -> alleles[0]) != CNULL) fprintf(fff, " %c", c) ;
- if ((c = cupt -> alleles[1]) != CNULL) fprintf(fff, " %c", c) ;
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void printdata(char *genooutfilename, char *indoutfilename,
- SNP **snpm, Indiv **indiv, int numsnps, int numind, int packem) {
-
- FILE *gfile, *ifile;
- int i,j, t;
- SNP *cupt;
- Indiv *indx;
- char ss[MAXSTR];
- char *gfilename ;
- int dogenos = YES ;
-
- if (packem)
- printf("packedancestrymap output\n") ;
- else
- printf("ancestrymap output\n") ;
-
- if ((genooutfilename != NULL) && (strcmp(genooutfilename, "NULL") == 0)) dogenos = NO ;
- if (genooutfilename == NULL) dogenos = NO ;
-
- if (dogenos) {
- gfilename = genooutfilename ;
- if (packem) {
- outpack(genooutfilename, snpm, indiv, numsnps, numind) ;
- gfilename = NULL ;
- }
-
- // print unpacked genotype output
- if (gfilename != NULL) {
- openit(gfilename, &gfile, "w") ;
- if(tersemode == NO) fprintf(gfile,"#SNP_ID,INDIV_ID,VART_ALLELE_CNT\n");
- }
-
- for (i = 0; i< numsnps; i++) {
- if (gfilename == NULL) break ;
- cupt= snpm[i];
-
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
-
- for(j=0; j < cupt->ngtypes; j++) {
- indx = indiv[j];
- if (indx -> ignore) continue ;
- fprintf(gfile,"%20s %20s %3d\n",cupt->ID,indx->ID, getgtypes(cupt,j)) ;
- }
- }
-
- if(gfilename != NULL)
- fclose(gfile);
-
- }
-
- if(indoutfilename == NULL)
- return;
- if ((indoutfilename != NULL) && (strcmp(indoutfilename, "NULL") == 0)) return ;
- if (indoutfilename != NULL)
- openit(indoutfilename, &ifile, "w") ;
-
- /* fprintf(ifile,"#INDIV,GENDER,POPULATION\n"); */
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- strcpy(ss, indx -> egroup) ;
- if ((qtmode) && (!indx->ignore)) {
- sprintf(ss, "%9.3f", indx -> rawqval) ;
- }
- if (tersemode) {
- fprintf(ifile,"%20s %c %10s",indx->ID, indx->gender,ss);
- fprintf(ifile,"\n") ;
- continue ;
- }
- t = numvalids(indx, snpm, 0, numsnps-1) ;
- fprintf(ifile,"%20s %c %10s %5d\n",indx->ID, indx->gender,ss, t);
- }
-
- if(indoutfilename != NULL)
- fclose(ifile);
-}
-
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readindval(Indiv **indivmarkers, int numindivs, char *inddataname) {
-
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
-
- FILE *fff ;
- openit(inddataname, &fff, "r") ;
- for (k=0; k <numindivs; ++k) {
- indx = indivmarkers[k] ;
- indx -> affstatus = NO ;
- indx -> qval = -999.0 ;
- }
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit < 2) {
- freeup(spt, nsplit) ;
- continue ;
- }
- sx = spt[0] ;
- if (strcmp(sx, "Indiv_Index") == 0) {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readindval) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
- indx -> qval = atof(spt[1]) ;
- indx -> affstatus = YES ;
- freeup(spt, nsplit) ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int readgdata(Indiv **indivmarkers, int numindivs, char *gname)
- // only needed for logreg
- // not correct for X chromosome
- // Needs correction for males
-{
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k, ind ;
- int skipit ;
- Indiv *indx ;
- double y ;
- double gg[3] ;
-
- FILE *fff ;
-
- cleartg(indivmarkers, numindivs) ;
- openit(gname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- skipit = setskipit(sx) ;
- if (skipit == NO) {
- if (nsplit<4) fatalx("%s bad line: %s", gname, line) ;
- ind = indindex(indivmarkers, numindivs, sx) ;
- if (ind<0) fatalx("(readgdata) indiv: %s not found \n", sx) ;
- indx = indivmarkers[ind] ;
- for (k=0; k<3; k++) {
- gg[k] = atof(spt[k+1]) ;
- }
- y = asum(gg, 3) ;
- vst(gg, gg, 1.0/y, 3) ;
- y = 0.5*(gg[1]+2.0*gg[2]) ; /* est caucasian ancestry */
- indx -> thetatrue = y ;
- copyarr(gg, indx -> totgamms, 3) ;
- }
- freeup(spt, nsplit) ;
- continue ;
- }
-
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int putweights(char *fname, SNP **snpm, int numsnps) {
- int num=0, k ;
- SNP *cupt ;
- double weight ;
-
- FILE *fff ;
- openit(fname, &fff, "w") ;
-
- for (k=0; k<numsnps; ++k) {
- cupt = snpm[k] ;
- if (cupt -> ignore) continue ;
- fprintf(fff, "%20s ", cupt -> ID) ;
- fprintf(fff, "%15.9f ", cupt -> weight) ;
- fprintf(fff, "\n") ;
- ++num ;
- }
- fclose(fff) ;
- return num ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int getweights(char *fname, SNP **snpm, int numsnps) {
- // number of real lines
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0 ;
- int skipit, k ;
- double weight ;
-
- FILE *fff ;
- for (k=0; k<numsnps; ++k) {
- snpm[k] -> weight = 1.0 ;
- }
- openit(fname, &fff, "r") ;
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit == 0) {
- continue ;
- }
- sx = spt[0] ;
- skipit = NO ;
- skipit = setskipit(sx) ;
- k = snpindex(snpm, numsnps, sx) ;
- if (k<0) skipit = YES ;
- if (skipit == NO) {
- if (nsplit >1) {
- sx = spt[1] ;
- weight = atof(sx) ;
- snpm[k] -> weight = weight ;
- printf("weight set: %20s %9.3f\n", snpm[k] -> ID, weight) ;
- ++num ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- fclose(fff) ;
- fflush(stdout) ;
- return num ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
- char **arrx ;
- int n, num, ihash, shash, i, g, j, k ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt ;
- double y ;
- unsigned char *buff ;
- int fdes, ret ;
- char *packit ;
-
- n = numind ;
- ZALLOC(arrx, n, char *) ;
-
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- if ((outputall == NO ) && indx -> ignore) continue ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
-
- // compute hash on individuals
- ihash = hasharr(arrx, num) ;
- nind= num ;
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- arrx[num] = strdup(cupt -> ID) ;
- ++num ;
- }
-
- // compute hash on SNPs
- shash = hasharr(arrx, num) ;
- nsnp = num ;
- freeup(arrx, num) ;
- free(arrx) ;
- // printf("ihash: %x shash: %x\n", ihash, shash) ;
-
- // rlen is number of bytes each SNP will occupy in packed format
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- // printf("nind: %d rlen: %d\n", nind, rlen) ;
- ZALLOC(buff, rlen, unsigned char) ;
- sprintf((char *) buff,"GENO %7d %7d %x %x", nind, nsnp, ihash, shash) ;
-
- ridfile(genooutfilename) ;
- fdes = open(genooutfilename, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad genoout") ;
- fatalx("open failed for %s\n", genooutfilename) ;
- }
- if (verbose)
- printf("file %s opened\n", genooutfilename) ;
-
- ret = write(fdes, buff, rlen) ;
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
-
- irec = 1;
- for (i=0; i<numsnps ; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- cclear((unsigned char *) buff, 0X00, rlen) ;
- num = 0 ;
- for (j=0; j< numind; j++) {
- indx = indiv[j] ;
- if (indx -> ignore) continue ;
- g = getgtypes(cupt, j) ;
- if (g<0) g=3 ;
- wbuff( buff, num, g) ; // store two-bit genotype in packed data buffer
- ++num ;
- }
- ret = write(fdes, buff, rlen) ; // print out all SNPs in packed data buffer
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- if (verbose) {
- printf("record: %4d ", irec) ;
- for (k=0; k<rlen; ++k) {
- printf(" %02x", (unsigned char) buff[k]) ;
- }
- printf("\n") ;
- }
- ++irec ;
- }
- close(fdes) ;
- free(buff) ;
- // printf("check: %s %d\n", genooutfilename, ispack(genooutfilename)) ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ispack(char *gname) {
- // checks if file is packed gfile
- int fdes, t, ret ;
- char buff[8] ;
-
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(ispack) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, 8 ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(ispack) bad read") ;
- }
- close(fdes) ;
- buff[4] = '\0' ;
- ret = strcmp(buff, "GENO") ;
- if (ret == 0) return YES ;
- return NO ;
-
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int iseigenstrat(char *gname) {
-
- FILE *fff ;
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
-
-
- openit(gname, &fff, "r") ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit ==0 ) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- freeup(spt, nsplit) ;
- fclose(fff) ;
- if (nsplit>1) return NO ;
- return YES ;
- }
- fatalx("(iseigenstrat) no genotyped data found\n") ;
-
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ineigenstrat(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
- // supports enhanced format fist character X => all missing data for SNP
- FILE *fff ;
- char *line = NULL, c ;
- char *spt[2], *sx ;
- int nsplit, rownum=0, k, num ;
- int maxstr, maxff = 2 ;
- int nind, nsnp, len ;
- double y ;
- unsigned char *buff ;
- char *packit, *pbuff ;
- int g, g1, g2 ;
- SNP *cupt ;
- Indiv *indx ;
- int nbad=0 ;
-
-
- packmode = YES ;
- maxstr = numind+10 ;
- ZALLOC(line, maxstr, char) ;
-
- nind = numind ;
- nsnp = numsnps ;
-
- // rlen is number of bytes used to store each SNP's genotype data
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
-
- packlen = rlen*nsnp ;
- if (packgenos==NULL) {
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
- }
-
- openit(gname, &fff, "r") ;
-
- rownum = 0 ;
- pbuff = packgenos ;
- while (fgets(line, maxstr, fff) != NULL) {
- nsplit = splitup(line, spt, maxff) ;
- if (nsplit ==0 ) continue ;
-
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- if (nsplit>1) fatalx("(ineigenstrat) more than 1 field\n") ; // white space not expected
-
- if (rownum>=numsnps) fatalx("(ineigenstrat) too many lines in file %d %d\n", rownum, numsnps) ;
- num = snpord[rownum] ;
- cupt = snpm[num] ;
- ++rownum ;
- if (cupt == NULL) continue ;
-
- if (cupt -> ngtypes == 0) {
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numind, int) ;
- ivclear(cupt -> gtypes, -1, numind) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numind ;
- }
-
- if (sx[0] == 'X') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- len = strlen(sx) ;
- if (len != nind) {
- printf("(ineigenstrat) bad line %d ::%s\n", rownum, line) ;
- fatalx("(ineigenstrat) mismatch line length %d %d\n", len, nind) ;
- }
-
- for (k=0; k<len; k++) {
- sscanf(sx+k, "%c", &c) ;
- g = -2 ;
- if (c=='0') g = 0 ;
- if (c=='1') g = 1 ;
- if (c=='2') g = 2 ;
- if (c=='9') g = -1 ;
-
- if (g==-2) fatalx("(ineigenstrat) bad character %c\n", c) ;
- if (indiv[k] -> ignore) g = -1 ;
- if (checkxval(cupt, indiv[k], g) == NO) g = -1 ;
-
- indx = indiv[k] ;
- if (checkxval(cupt, indx, g) == NO) g = -1 ;
- g2 = g ;
- if (g2<0) continue ;
- g1 = getgtypes(cupt, k) ;
- if ( (g1>=0) && (g1 != g2)) ++nbad ; // something is already stored there
- putgtypes(cupt, k, g2) ;
- }
- freeup(spt, nsplit) ;
- }
- if (rownum != numsnps) fatalx("(ineigenstrat) mismatch in numsnps %d and numlines %d\n", numsnps, rownum) ;
- fclose(fff) ;
- freestring(&line) ;
-
- return nbad ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash) {
- char **arrx ;
- int ihash, shash, n, num ;
- int i ;
- Indiv *indx ;
- SNP *cupt ;
-
- n = numind ;
- ZALLOC(arrx, n, char *) ;
-
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
- *pihash = hasharr(arrx, num) ;
-
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- arrx[num] = strdup(cupt -> ID) ;
- cupt -> ngtypes = numind ;
- ++num ;
- }
- *pshash = hasharr(arrx, num) ;
- freeup(arrx, num) ;
- free(arrx) ;
- return num ;
-
-}
-
-
-long bigread(int fdes, char *packg, long numbytes)
-{
- long x ;
- int xx ;
- char *pt ;
- long nb, t, nr=0 ;
- int pswitch = NO ;
-
-
- pt = packg ;
-
- x = nnint(pow(2, 30)) ;
-
- nb = numbytes ;
- if (nb>x) pswitch = YES ;
-
- for (;;) {
- xx = MIN(x, nb) ;
- t = read(fdes, pt, xx ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(bigread) bad data read") ;
- }
- if (t != xx) {
- perror("read failure (length mismatch)") ;
- fatalx("(bigread) bad data read (length mismatch) %ld %ld\n", t, xx) ;
- }
- nb -= xx ;
- nr += xx ;
- if (pswitch) printf("read %ld bytes\n", nr) ;
- if (nb==0) break ;
- pt += xx ;
- }
- return nr ;
-}
-
-int getsnpordered()
-{
- return snpordered ;
-}
-
-void putsnpordered(int mode)
-{
- snpordered = mode ;
-}
-
-void setpordercheck (int mode)
-{
- pordercheck = mode ;
-}
-
-void failorder()
-{
- fatalx("snps out of order and packed format. Run convertf with pordercheck: NO\n") ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void inpack(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
-
- char **arrx, junk[10] ;
- int n, num, ihash, shash, i, g, j, k ;
- long t ;
- int xihash, xshash, xnsnp, xnind ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt ;
- double y ;
- unsigned char *buff ;
- int fdes, ret ;
- char *packit, *pbuff ;
-
- nind = n = numind ;
- nsnp = calcishash(snpm, indiv, numsnps, numind, &ihash, &shash) ;
-
- // rlen is the number of bytes needed to store one SNP's genotype data
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
-
- // open binary file and check readability
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(ispack) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, rlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack) bad read") ;
- }
-
- if (pordercheck && (snpordered == NO)) failorder() ;
-
- // check for file modification
- if (hashcheck) {
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
- if (xnind != nind) fatalx("OOPS number of individuals %d != %d in input files\n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp, gname) ;
- if (xihash != ihash) fatalx("OOPS indiv file has changed since genotype file was created\n") ;
- if (xshash != shash) fatalx("OOPS snp file has changed since genotype file was created\n") ;
- }
-
- packlen = rlen*nsnp ;
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
-
- // printf("packgenos: %x end: %x len: %d\n", packgenos, packgenos+packlen-1, packlen) ;
-
- t = bigread(fdes, packgenos, packlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack) bad data read") ;
- }
- if (t != packlen) {
- perror("read failure (length mismatch)") ;
- printf("numsnps: %d nsnp (from geno file): %d\n", numsnps, nsnp) ;
- fatalx("(inpack) bad data read (length mismatch) %ld %ld\n", t, packlen) ;
- }
- else printf("packed geno read OK\n") ;
-
- // now set up pointers into packed data
- pbuff = packgenos ;
- for (i=0; i<numsnps ; i++) {
- j = snpord[i] ;
- if (snpordered == YES) j = i ;
- if (j<0) fatalx("(inpack) bug\n") ;
- if (j>nsnp) fatalx("(inpack) bug\n") ;
- cupt = snpm[j] ;
- if (cupt -> isfake) continue ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- // now check xhets
- for (k=0; k<numind; ++k) {
- indx = indiv[k] ;
- g = getgtypes(cupt, k) ;
- if (checkxval(cupt, indx, g) == NO) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-
- free(buff) ;
- close(fdes) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void getsnpsc(char *snpscname, SNP **snpm, int numsnps) {
-
- FILE *fff ;
- int score ;
- SNP *cupt ;
- char line[MAXSTR] ;
- char *spt[MAXFF], *sx ;
- int nsplit, num=0, k ;
- double y ;
-
-
- if (snpscname == NULL) fatalx("no snpsc file\n") ;
- else openit(snpscname, &fff, "r") ;
-
- while (fgets(line, MAXSTR, fff) != NULL) {
- nsplit = splitup(line, spt, MAXFF) ;
- if (nsplit ==0 ) continue ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- k = snpindex(snpm, numsnps, sx) ;
- if (k<0) {
- printf("*** warning. snp %s in snpscname but not in main snp file\n", spt[0]) ;
- freeup(spt, nsplit) ;
- continue ;
- }
- y = atof(spt[1]) ;
- y += .1 * gauss() ; // dither
- cupt = snpm[k] ;
- cupt -> score = y ;
- freeup(spt, nsplit) ;
- }
-
- if (snpscname != NULL) fclose(fff) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setepath(SNP **snpm, int nsnps) {
-
- int i ;
- SNP *cupt ;
- char *pbuff ;
-
- if (packlen==0) fatalx("(setepath) packlen unset\n") ;
- ZALLOC(packepath, packlen, char) ;
- printf("setepath. packlen: %ld rlen: %ld\n", packlen, rlen) ;
- pbuff = packepath ;
- for (i=0 ; i<nsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- cupt -> ebuff = pbuff ;
- pbuff += rlen ;
- }
- clearepath(packepath) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void clearepath(char *packp) {
- cclear((unsigned char *) packp, 0XFF, packlen) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int getpedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore) {
- int val ;
- int ngenos = 0 ;
-
- SNP *cupt ;
- Indiv *indx ;
-
- char *line ;
- char **spt, *sx ;
- char c ;
- int nsplit, num=0 ;
- int skipit ;
- int numf, snpnumber, nsnp ;
- int k, n, t, i ;
- FILE *fff ;
- int **gcounts, *gvar, *gref ;
- int xvar, xref ;
- int parity, colbase, ncols ;
- int snpnum ;
- int markernum = -99 ;
- int n1, n2 ;
-
- /*
- markernum = snpindex(snpmarkers, numsnps, "rs3002685") ;
- if (markernum <0) fatalx("qq1") ;
- */
-
- maxgenolinelength = MAX(maxgenolinelength, maxlinelength(gname)) ;
-
- // printf("maxlinelen %d\n", maxlinelength(gname)) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
-
- cleargdata(snpmarkers, numsnps, numindivs) ;
- nsnp = numsnps ;
-
- ZALLOC(gcounts, nsnp, int *) ;
- for (i=0; i<nsnp; i++) {
- ZALLOC(gcounts[i], 5, int) ;
- }
- genopedcnt(gname, gcounts, nsnp) ;
-
- ZALLOC(gvar, nsnp, int) ;
- ZALLOC(gref, nsnp, int) ;
-
- // designate ref and var alleles from counts
- setgref(gcounts, nsnp, gvar, gref) ;
-
- // Override improvised ref and var designations if they were in the .map file
- for (i=0; i<nsnp; ++i) {
- cupt = snpmarkers[i] ;
- if (cupt -> alleles[0] != CNULL) {
- c = cupt -> alleles[0] ;
- gvar[i] = xpedval(c) ;
- c = cupt -> alleles[1] ;
- gref[i] = xpedval(c) ;
- }
- else {
- c = x2base(gvar[i]) ;
- cupt -> alleles[0] = c ;
- c = x2base(gref[i]) ;
- cupt -> alleles[1] = c ;
- }
- }
-
- numf = 2*nsnp+10 ;
- ZALLOC(spt, numf, char *) ;
-
- // Read genotype file, one line per individual
- openit(gname, &fff, "r") ;
- while (fgets(line, maxgenolinelength, fff) != NULL) {
-
- nsplit = splitup(line, spt, numf) ;
- if (nsplit == 0) continue ;
- sx = spt[0] ;
- skipit = NO ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
-
- // On first individual, set column base (6 or 7)
- if (num==0) {
- parity = nsplit % 2 ;
- ncols = nsplit ;
- colbase = 6 + parity ;
- }
- if (nsplit != ncols)
- fatalx("bad number of fields %d %d\n", ncols, nsplit) ;
-
- // Loop over SNPs
- for (k=colbase ; k < nsplit-1 ; k+=2) {
- snpnumber = (k-colbase)/2 ;
-
- if (snpnumber >= numsnpord) fatalx("snpord overflow\n") ;
- snpnum = snpord[snpnumber] ;
- if (snpnum<0) fatalx("logic bug (bad snpord)\n") ;
-
- xvar = gvar[snpnum] ;
- xref = gref[snpnum] ;
-
- t = 0 ;
-
- n1 = n = pedval(spt[k]) ;
- n2 = pedval(spt[k+1]) ;
-
- if ((n1==5) && (n2==5)) { // Missing data
- val = -1 ;
- putgtypes(cupt, num, val) ;
- continue ;
- }
-
- if ((n<0) || (n>4)) fatalx("(getpedgenos) %s bad geno %s\n", gname, spt[k]) ;
- if (n==xvar) ++t ;
- if ((n != xvar) && (n != xref)) t = -10 ;
-
- n = n2 ;
- if ((n<0) || (n>4)) fatalx("(getpedgenos) %s bad geno %s\n", gname, spt[k+1]) ;
- if (n==xvar) ++t ;
- if ((n != xvar) && (n != xref)) t = -10 ;
-
- if (t<0) t = -1 ; // Any unexpected allele is stored as "missing"
- cupt = snpmarkers[snpnum] ;
- if (cupt -> ignore) continue ;
- val = t ;
- if (checkxval(cupt, indivmarkers[num], val) == NO) val = -1 ;
- putgtypes(cupt, num, val) ; // Store genotype
- if (val>=0) ++ngenos ;
-
- } // rof (SNP)
- freeup(spt, nsplit) ;
- ++num ;
-
- } // elihw (individual)
-
- free(spt) ;
- fclose(fff) ;
-
- for (i=0; i<nsnp; i++) {
- free(gcounts[i]) ;
- }
-
- free(gcounts) ;
- free(gref) ;
- free(gvar) ;
- free(line) ;
-
- printf("genotype file processed\n") ;
- return ngenos ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void genopedcnt(char *gname, int **gcounts, int nsnp) {
- char *line ;
- char **spt, *sx ;
- int nsplit, num=0 ;
- int skipit ;
- int numf, snpnumber, snpnum ;
- int k, n ;
- FILE *fff ;
- int parity, ncols, colbase ;
-
- // gcounts already zeroed
-
- maxgenolinelength = MAX(maxgenolinelength, maxlinelength(gname)) ;
-
- // printf("maxlinelen %d\n", maxlinelength(gname)) ;
- ZALLOC(line, maxgenolinelength+1, char) ;
-
- numf = 2*nsnp+10 ;
- ZALLOC(spt, numf, char *) ;
-
- openit(gname, &fff, "r") ;
- while (fgets(line, maxgenolinelength, fff) != NULL) {
-
- nsplit = splitup(line, spt, numf) ;
- if (nsplit == 0) continue ;
- skipit = NO ;
- sx = spt[0] ;
- if (sx[0] == '#') {
- freeup(spt, nsplit) ;
- continue ;
- }
- if (num==0) {
- parity = nsplit % 2 ;
- ncols = nsplit ;
- colbase = 6 + parity ; // QUESTION: what is the optional seventh column?
- }
-
- for (k=colbase ; k < nsplit-1 ; k+=2) {
- snpnumber = (k-colbase)/2 ;
- if (snpnumber >= numsnpord) fatalx("snpord overflow\n") ;
- snpnum = snpord[snpnumber] ;
- if (snpnum<0) fatalx("logic bug (bad snpord)\n") ;
- n = pedval(spt[k]) ;
- // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k]) ;
- if ((n<0) || (n>4)) continue ;
- if (n>0) {
- ++gcounts[snpnum][n] ;
- ++num ;
- }
- n = pedval(spt[k+1]) ;
- // if ((n<0) || (n>4)) fatalx("(genopedcnt) %s bad geno %s\n", gname, spt[k+1]) ;
- if ((n<0) || (n>4)) continue ;
- if (n>0) {
- ++gcounts[snpnum][n] ;
- ++num ;
- }
- }
- freeup(spt, nsplit) ;
- continue ;
- }
- free(spt) ;
- free(line) ;
- fclose(fff) ;
- return ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outfiles(char *snpname, char *indname, char *gname, SNP **snpm,
- Indiv **indiv, int numsnps, int numindx, int packem, int ogmode) {
- /* call at end of main program usually */
-
- int sizelimit = 10000000 ;
- int numind ;
-
- // Squeeze out individuals with ignore flag set
- numind = rmindivs(snpm, numsnps, indiv, numindx) ;
- if (snpname == NULL) {
- printf("*** warning output snpname NULL\n") ;
- printf("snpname: %s %d\n", snpname, numsnps) ;
- printf("indname: %s %d\n", indname, numind) ;
- printf("gname: %s\n", gname) ;
- }
-
- switch (outputmode) {
-
- case EIGENSTRAT:
- printf("eigenstrat output\n") ;
- outeigenstrat(snpname, indname, gname, snpm, indiv, numsnps, numind) ;
- return ;
-
- case PED:
- printf("ped output\n") ;
- outped(snpname, indname, gname, snpm, indiv, numsnps, numind, ogmode) ;
- return ;
-
- case PACKEDPED:
- printf("packedped output\n") ;
- outpackped(snpname, indname, gname, snpm, indiv, numsnps, numind, ogmode) ;
- return ;
-
- case PACKEDANCESTRYMAP:
- if (snpname != NULL) printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
- packem = YES ;
- printdata(gname, indname, snpm, indiv, numsnps, numind, packem) ;
- return ;
-
- case ANCESTRYMAP:
- default:
- if (snpname != NULL) printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
- packem = NO ;
- if (numsnps > (sizelimit/numind)) packem = YES ;
- printdata(gname, indname, snpm, indiv, numsnps, numind, packem) ;
- return ;
- }
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outeigenstrat(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv, int numsnps,
- int numind) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char ss[MAXSTR] ;
-
-
- settersemode(YES) ;
- if (snpname != NULL)
- printsnps(snpname, snpm, numsnps, indiv, NO, NO) ;
-
- // Print individual data to .ind file
- if (indname != NULL) {
- openit(indname, &ifile, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- strcpy(ss, indx -> egroup) ;
- if (qtmode) {
- sprintf(ss, "%9.3f", indx -> rawqval) ;
- }
- fprintf(ifile,"%20s %c %10s",indx->ID, indx->gender,ss);
- fprintf(ifile,"\n") ;
- continue ;
- }
- fclose(ifile) ;
- }
-
- if (gname == NULL) return ;
-
- // Print genotypes to .geno file
- openit(gname, &fff, "w") ;
- for (k=0; k< numsnps; k++) {
- cupt = snpm[k] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- for (i=0; i<numind; i++) {
- indx = indiv[i] ;
- if (indx->ignore) continue ;
- g = getgtypes(cupt, i) ;
- if (g<0) g=9 ;
- fprintf(fff, "%1d", g);
- }
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setgref(int **gcounts, int nsnp, int *gvar, int *gref) {
- int tt[5] ;
- int i, kmax ;
-
- for (i=0; i<nsnp; i++) {
- copyiarr(gcounts[i], tt, 5) ;
- tt[0] = -9999 ; // Ensure "missing data" is not ref or var allele
- ivlmaxmin(tt, 5, &kmax, NULL) ;
- gvar[i] = kmax ; // designate major allele "variant"
- if (tt[kmax] == 0) gvar[i] = 5 ;
- tt[kmax] = -9999 ;
- ivlmaxmin(tt, 5, &kmax, NULL) ;
- gref[i] = kmax ; // designate minor allele "variant"
- if (tt[kmax] == 0) gref[i] = 5 ;
- }
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void cleargdata(SNP **snpmarkers, int numsnps, int numindivs) {
-
- // wipe out all genotype data
- int i , k ;
- SNP *cupt ;
- char *pbuff ;
- double y ;
-
- // rlen is number of bytes needed to store each SNP's genotype data in packed mode
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- packlen = rlen*numsnps ;
-
- if (packlen <= 0) fatalx("bad packlen\n") ;
-
- if ((packmode) && (packgenos == NULL)) {
- ZALLOC(packgenos, packlen, char) ;
- clearepath(packgenos) ;
- }
-
- pbuff = packgenos ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- // if (cupt -> ignore) continue ;
- if (cupt -> ngtypes == 0) {
- if (packmode == NO) {
- ZALLOC(cupt -> gtypes, numindivs, int) ;
- }
- else {
- ZALLOC(cupt -> gtypes, 1, int) ;
- cupt -> pbuff = pbuff ;
- pbuff += rlen ;
- }
- cupt -> ngtypes = numindivs ;
- for (k=0; k<numindivs; ++k) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setgenotypename(char **gname, char *iname) {
- if (ispedfile(iname) == NO) return ;
- if ((*gname != NULL) && strcmp(*gname, "NULL") ==0) {
- *gname = NULL ;
- return ;
- }
- if (*gname != NULL) return ;
- *gname = strdup(iname) ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int maxlinelength(char *fname) {
- // linelength including \n
-
- int len, maxlen ;
- int nl, t ;
- FILE *fff ;
-
- maxlen = -1 ;
-
- len = 0 ;
- nl = (int) (unsigned char) '\n' ;
-
- openit(fname, &fff, "r") ;
- while ((t = fgetc(fff)) != EOF) {
- ++len ;
- if (t==nl) {
- maxlen = MAX(maxlen, len) ;
- len = 0 ;
- }
- }
- return maxlen ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void settersemode(int mode) {
- tersemode = mode ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outindped(char *indname, Indiv **indiv, int numind, int ogmode) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int dcode = 1 ;
-
- if (indname == NULL) return ;
-
- openit(indname, &ifile, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- fprintf(ifile, "%6d %12s", i+1, indx->ID) ;
- fprintf(ifile, " %d %d", 0, 0) ; // parents
- c = indx->gender ;
- pgender = 0 ;
- if (c == 'M') pgender = 1 ;
- if (c == 'F') pgender = 2 ;
- fprintf(ifile, " %d", pgender) ;
- if (ogmode == NO) {
- astatus = indx -> affstatus + 1 ;
- if (qtmode) {
- fprintf(ifile, "%9.3f", indx -> rawqval) ;
- }
- else {
- fprintf(ifile, " %d", astatus) ;
- }
- }
- if (ogmode == YES) fprintf(ifile, " %10s", indx -> egroup) ;
- if (sevencolumnped) fprintf(ifile, " %d", dcode) ;
- fprintf(ifile, "\n") ;
- }
- fclose(ifile) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int g1, g2, dcode=1 ;
-
- settersemode(YES) ;
- if (snpname != NULL)
- printmap(snpname, snpm, numsnps, indiv) ; // print .map file
-
- if (indname!=NULL)
- outindped(indname, indiv, numind, ogmode) ; // print .pedind file
-
- // Here, printt the .ped file
- if (gname == NULL) return ;
- openit(gname, &fff, "w") ;
- for(i = 0; i< numind; i++) {
- indx = indiv[i];
- if (indx->ignore) continue ;
- fprintf(fff, "%6d %12s", i+1, indx->ID) ; // make up a family name (index) and print individual name
- fprintf(fff, " %d %d", 0, 0) ; // set parents to "not in data set"
- c = indx->gender ;
- pgender = 0 ;
- if (c == 'M') pgender = 1 ;
- if (c == 'F') pgender = 2 ;
- fprintf(fff, " %d", pgender) ;
- if (ogmode == NO) {
- astatus = indx -> affstatus +1 ;
- if (qtmode) {
- fprintf(fff, "%9.3f", indx -> rawqval) ;
- }
- else
- fprintf(fff, " %d", astatus) ;
- }
- if (ogmode == YES) fprintf(fff, " %10s", indx -> egroup) ;
- if (sevencolumnped) fprintf(fff, " %d", dcode) ;
- for (k=0; k<numsnps; k++) {
- cupt = snpm[k] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- g = getgtypes(cupt, i) ;
- gtox(g, cupt -> alleles, &g1, &g2) ;
- fprintf(fff, " %d %d", g1, g2 ) ;
- if ((g1>4) || (g2>4)) {
- fprintf(fff, "\n") ;
- fflush(fff) ;
- fclose(fff) ;
- printf("bad genotype for snp %s alleles: ", cupt -> ID) ;
- printalleles(cupt, stdout) ;
- printf("\n") ;
- fatalx("trying to make invalid ped file %s\n", gname) ;
- }
- }
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void gtox(int g, char *cvals, int *p1, int *p2) {
- // output values for ped file using allele array
- int g1, g2 ;
-
- switch (g) {
- case -1:
- *p1 = *p2 = 0;
- return ;
- case 0:
- g1 = 1 ;
- g2 = 1;
- break ;
- case 1:
- g1 = 1 ;
- g2 = 2;
- break ;
- case 2:
- g1 = 2 ;
- g2 = 2;
- break ;
- default:
- fatalx("(outped) bug %d\n", g) ;
- }
-
- if (cvals != NULL) {
- g1 = 3-g1 ;
- g2 = 3-g2 ;
- g1 = xpedval(cvals[g1-1]) ;
- g2 = xpedval(cvals[g2-1]) ;
- }
-
- *p1 = MIN(g1, g2) ;
- *p2 = MAX(g1, g2) ;
-
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void outpackped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode) {
-
- FILE *fff, *ifile ;
- int g, i, k ;
- SNP *cupt ;
- Indiv *indx ;
- char c ;
- int pgender, astatus ;
- int g1, g2, dcode=1 ;
- unsigned char ibuff[3] ;
- unsigned char *buff ;
- int fdes, ret, blen ;
- int *gtypes ;
- double y ;
-
- settersemode(YES) ;
- if (snpname!=NULL)
- printmap(snpname, snpm, numsnps, indiv) ; // print .map (not .bim)
-
- if (indname != NULL) // print .pedind file
- outindped(indname, indiv, numind, ogmode) ;
-
- if (gname == NULL) return ;
-
- /* magic constants for snp major bed file */
- ibuff[0] = 0x6C ;
- ibuff[1] = 0x1B ;
- ibuff[2] = 0x01 ;
-
-
- // blen is number of bytes each SNP's data requires
- y = (double) (numind * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
- ZALLOC(buff, blen, unsigned char) ;
- ZALLOC(gtypes, numind, int) ;
-
- // open output file and check readability
- fdes = open(gname, O_CREAT | O_TRUNC | O_RDWR, 0666);
- if (fdes<0) {
- perror("bad gname") ;
- fatalx("open failed for %s\n", gname) ;
- }
- if (verbose)
- printf("file %s opened\n", gname) ;
-
- if (fdes<0) {
- perror("bad genoout") ;
- fatalx("open failed for %s\n", gname) ;
- }
-
- if (verbose)
- printf("file %s opened\n", gname) ;
-
- ret = write(fdes, ibuff, 3) ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- for (k=0; k<numind; ++k) {
- g = getgtypes(cupt, k) ;
- if (g>=0) g = 2 - g ;
- gtypes[k] = g ;
- }
- setbedbuff((char *) buff, gtypes, numind) ;
- ret = write(fdes, buff, blen) ;
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpackped) bad write") ;
- }
- }
-
- free(buff) ;
- close(fdes) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setbedbuff(char *buff, int *gtypes, int numind ) {
- int i, k ;
- double y ;
- int blen, wnum, wplace, bplace, t, g ;
- unsigned char c ;
-
- y = (double) (numind * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
-
- c = 0xAA ; // missing
- cclear((unsigned char *) buff, c, blen) ; // initialize buffer to "missing"
-
- for (k=0; k<numind; k++) {
- wnum = k/4 ;
- t = k%4 ;
- wplace = 3-t ; // switch for bed
- bplace = 4*wnum + wplace ;
- g = bedval(gtypes[k]) ;
- wbuff((unsigned char *) buff, bplace, g) ;
- }
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int bedval(int g) {
- if (g<0) return 1 ;
- if (g==2) return 3 ;
- if (g==1) return 2 ;
- if (g==0) return 0 ;
-
- fatalx("(bedval) bad g value %d\n", g) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void atopchrom(char *ss, int chrom) {
-
- // ancestry chromosome -> map convention
-
-/**
- if ( chrom == numchrom+1 ) {
- strcpy(ss, "X") ;
- return ;
- }
- else if ( chrom == numchrom+2 ) {
- strcpy(ss, "Y") ;
- return ;
- }
-*/
- sprintf(ss, "%d", chrom) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ptoachrom(char *ss) {
- // map -> ancestry
- char c ;
- c = ss[0] ;
-
- if (c=='X') return (numchrom+1) ;
- if (c=='Y') return (numchrom+2) ;
- return atoi(ss) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void printmap(char *snpname, SNP **snpm, int numsnps, Indiv **indiv) {
-
- char ss[5] ;
- int i ;
- FILE *fff ;
- SNP *cupt ;
- char c ;
-
- if (snpname == NULL) return ;
- openit(snpname, &fff, "w") ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (outputall==NO) {
- if (ignoresnp(cupt)) continue ;
- if (cupt -> isrfake) continue ;
- }
- atopchrom(ss, cupt -> chrom) ;
- fprintf(fff, "%-2s", ss) ;
- fprintf(fff, " %12s", cupt -> ID) ;
- fprintf(fff, " %12.6f", cupt -> genpos) ;
- fprintf(fff, " %12.0f", cupt -> physpos) ;
- printalleles(cupt, fff) ;
- fprintf(fff, "\n") ;
- }
- fclose(fff) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-char x2base(int x) {
- // 12345 -> ACGTX
- char *blist = "?ACGT" ;
- if (x<0) return '?' ;
- if (x>4) return 'X' ;
- return blist[x] ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int xpedval(char c) {
- char bb[2] ;
-
- bb[1] = '\0' ;
- bb[0] = c ;
-
- if (isdigit(c)) return atoi(bb) ;
- return pedval(bb) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int pedval(char *sx) {
- char c ;
-
- c = sx[0] ;
- if (c=='A') return 1 ;
- if (c=='C') return 2 ;
- if (c=='G') return 3 ;
- if (c=='T') return 4 ;
- if (c=='X') return 5 ;
- if (c=='N') return 5 ;
- if (c=='N') return 5 ;
- if (c=='D') return 5 ;
- if (c=='I') return 5 ;
-
- if (c=='1') return 1 ;
- if (c=='2') return 2 ;
- if (c=='3') return 3 ;
- if (c=='4') return 4 ;
- if (c=='0') return 0 ;
-
- if (badpedignore) return 5 ;
-
- return 9 ;
-
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore) {
-
- int val, i, k, x, j ;
- int t, wnum, wplace ;
- int nsnp ;
- int ngenos = 0 ;
-
- SNP *cupt ;
- Indiv *indx ;
-
- unsigned char *buff, ibuff[3], jbuff[3] ;
- double y ;
- int blen ;
- int fdes ;
-
- // magic numbers for BED identification
- ibuff[0] = 0x6C ;
- ibuff[1] = 0x1B ;
- ibuff[2] = 0x01 ;
-
- cleargdata(snpmarkers, numsnps, numindivs) ;
- nsnp = numsnps ;
-
- if (pordercheck && (snpordered == NO)) failorder() ;
-
- // blen is number of bytes needed to store each SNP's genotype
- y = (double) (numindivs * 2) / (8 * (double) sizeof (char)) ;
- blen = nnint(ceil(y)) ;
- ZALLOC(buff, blen, unsigned char) ;
-
- // open binary file and check that it is readable
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(getbedgenos) bad open %s\n", gname) ;
- }
- t = read(fdes, jbuff, 3 ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(getbedgenos) bad read") ;
- }
-
- // check magic
- for (k=0; k<3; k++) {
- if (ibuff[k] != jbuff[k]) {
- fprintf(stderr, "magic failure: ") ;
- fprintf(stderr, " %x %x %x", jbuff[0], jbuff[1], jbuff[2]) ;
- fprintf(stderr, " %x %x %x", ibuff[0], ibuff[1], ibuff[2]) ;
- fprintf(stderr, "\n") ;
- fatalx("(getbedgenos) magic failure\n") ;
- }
- }
-
- // Read genotype data
- for (i=0; i<nsnp; i++) {
-
- j = snpord[i] ;
- if (snpordered == YES) j = i ;
- if (j<0) fatalx("(readbedgenos) bug\n") ;
- if (j>nsnp) fatalx("(readbedgenos) bug\n") ;
-
- cupt = snpmarkers[j] ;
- t = read(fdes, buff, blen) ;
-
- if (t<0) {
- perror("read failure") ;
- fatalx("(getbedgenos) bad read") ;
- }
- if (cupt -> ignore) continue ;
-
- for (k=0; k<numindivs; k++) {
- indx = indivmarkers[k] ;
- wnum = k/4 ;
- t = k%4 ;
- wplace = 3-t ; // switch for bed
- wplace += 4*wnum ;
- x = rbuff(buff, wplace) ;
- val = ancval(x) ;
- if (checkxval(cupt, indx, val) == NO) val = -1 ;
- putgtypes(cupt, k, val) ;
- if (val >= 0) ++ngenos ;
- }
- }
-
- free(buff) ;
- printf("genotype file processed\n") ;
- return ngenos ;
-
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int ancval(int x) {
- // bed -> anc
- // 1/22/07 allele flipped
- if (x==1) return -1 ;
- if (x==3) return 0 ;
- if (x==2) return 1 ;
- if (x==0) return 2 ;
- fatalx("(ancval) bad value %d\n", x) ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setomode(enum outputmodetype *outmode, char *omode) {
-
- char *ss ;
- int len, i ;
-
- if (outmode == NULL) return ;
- *outmode = PACKEDANCESTRYMAP ;
- if (omode == NULL) return ;
-
- ss = strdup(omode) ;
- len = strlen(ss) ;
- for (i=0; i<len ; i++) {
- ss[i] = tolower(ss[i]) ;
- }
-
- if (strcmp(ss, "eigenstrat") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "ascii") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "alkes") == 0) *outmode = EIGENSTRAT ;
- if (strcmp(ss, "ped") == 0) *outmode = PED ;
- if (strcmp(ss, "packedped") == 0) *outmode = PACKEDPED ;
- if (strcmp(ss, "packedancestrymap") == 0) *outmode = PACKEDANCESTRYMAP ;
- if (strcmp(ss, "ancestrymap") == 0) *outmode = ANCESTRYMAP ;
-
- free(ss) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void snpdecimate(SNP **snpm, int nsnp, int decim, int mindis, int maxdis) {
- int chrom = -1 ;
- SNP **cbuff, *cupt, *cupt2 ;
- int k, k2, n, t ;
-
- printf( "snpdecimate called: decim: %d mindis: %d maxdis: %d\n", decim, mindis, maxdis) ;
- ZALLOC(cbuff, nsnp, SNP *) ;
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- if (cupt -> chrom != chrom) {
- chrom = cupt -> chrom ;
- n = 0 ;
- for (k2=k; k2 <nsnp; ++k2) {
- cupt2 = snpm[k2] ;
- if (cupt2 -> chrom != chrom) break ;
- if (cupt2 -> ignore) continue ;
- if (cupt2 -> isfake) continue ;
- cbuff[n] = cupt2 ;
- ++n ;
- }
- if (n<decim) continue ;
- decimate(cbuff, n, decim, mindis, maxdis) ;
- }
- }
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void decimate(SNP **cbuff, int n, int decim, int mindis, int maxdis) {
- int k, t, u, dis, len ;
- int *ttt ;
- SNP *cupt ;
-
- cupt = cbuff[0] ;
- if (n<2) return ;
- if (n<decim) return ;
- ZALLOC(ttt, n, int) ;
- for (k=1; k<n; ++k) {
- dis = (int) (cbuff[k] -> physpos - cbuff[k-1] -> physpos) ;
- if (dis > maxdis) {
- decimate(cbuff, k-1, decim, mindis, maxdis) ;
- decimate(cbuff+k, n-k, decim, mindis, maxdis) ;
- return ;
- }
- }
- t = ranmod(decim) ;
- ttt[t] = 1 ;
-
- u = t + decim ;
-
- for (;;) {
- if (u>=n) break ;
- dis = (int) (cbuff[u] -> physpos - cbuff[t] -> physpos) ;
- if (dis<mindis) {
- ++u ;
- continue ;
- }
- len = u-t-1 ;
- ivclear(ttt+t+1, 1, len) ;
- t = u ;
- u = t + decim ;
- }
- for (k=0 ; k < n; ++k) {
- if (ttt[k] == 1) cbuff[k] -> ignore = YES ;
- }
-// debug
- if (verbose) {
- for (k=0 ; k < n; ++k) {
- printf("zz %6d %20s %20d %3d\n", k, cbuff[k] -> ID, (int) cbuff[k] -> physpos, ttt[k]) ;
- }
- }
-
- free(ttt) ;
-
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int killhir2(SNP **snpm, int numsnps, int numind, double physlim, double genlim, double rhothresh) {
- // physlim = genlim = 0 => kill monomorphs
- double *badbuff ;
- int *xbadbuff ;
- SNP *cupt, *cupt1, *cupt2 ;
-
-#define BADBUFFSIZE 100000 ;
-
- int badbuffsize = BADBUFFSIZE ;
- int i,j, k, nbad, kmax, kmin, t, j1, j2, lo, hi ;
- int *gtypes ;
- double *x1, *x2, mean, dis, *p1 ;
- int nkill = 0, tj ;
- double y1, y2, y, rho, smax ;
- double **xx1, *yy1 ;
- SNP **snpxl ;
-
- if (physlim<0) return 0 ;
- if (genlim<0) return 0 ;
-
- // step 1 give score to each SNP
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- if (cupt -> ignore) continue ;
- cupt -> score = numvalidgtypes(cupt) ;
- cupt -> score += DRAND() ; // jitter
- }
-
- ZALLOC(badbuff, badbuffsize, double) ;
- ZALLOC(xbadbuff, badbuffsize, int) ;
- ZALLOC(x1, numind, double) ;
- ZALLOC(x2, numind, double) ;
- ZALLOC(gtypes, numind, int) ;
-
- xx1 = initarray_2Ddouble(10000, numind, 0.0) ;
- ZALLOC(yy1, 10000, double) ;
- ZALLOC(snpxl, 10000, SNP *) ;
-
- for (i=0; i<numsnps; i+=5000) {
-
- lo = i ;
- hi = i+10000-1 ;
- hi = MIN(hi, numsnps-1) ;
-
- for (j=lo; j <=hi ; ++j) {
- p1 = xx1[j-lo] ;
- cupt = snpm[j] ;
- snpxl[j-lo] = cupt ;
- grabgtypes(gtypes, cupt, numind) ;
- floatit(p1, gtypes, numind) ;
- vvadjust(p1, numind, NULL) ;
- y1 = asum2(p1, numind) ;
- yy1[j-lo] = y1 ;
- if (y1<0.01) {
- ++nkill ;
- cupt -> ignore = YES ;
- }
- }
- for (j1 = 0 ; j1 < 5000; ++j1) {
- if (j1>(hi-lo)) break ;
- cupt1 = snpxl[j1] ;
- if (cupt1 -> ignore) continue ;
- nbad = 0 ;
- tj = 0 ;
- for (j2=j1+1; j2 <= hi-lo; ++j2) {
- cupt2 = snpxl[j2] ;
- if (cupt2 -> ignore) continue ;
- if (cupt2 -> chrom != cupt1 -> chrom) break ;
-
- dis = cupt2 -> genpos - cupt1 -> genpos ;
- if (dis > genlim) break ;
-
- dis = cupt2 -> physpos - cupt1 -> physpos ;
- if (dis > physlim) break ;
- ++tj ;
-
- y1 = yy1[j1] ;
- y2 = yy1[j2] ;
-
- y = vdot(xx1[j1], xx1[j2], numind) / sqrt(y1*y2) ; // compute correlation
- rho = y * y ;
- if (rho < rhothresh) continue ;
- badbuff[nbad] = cupt2 -> score ;
- xbadbuff[nbad] = j2+lo ;
- ++nbad ;
-
- }
- t = (j1+lo) % 100 ;
- if (nbad == 0) continue ;
- vlmaxmin(badbuff, nbad, &kmax, &kmin) ;
- smax = snpm[kmax] -> score ;
- if (smax > cupt1 -> score) {
- cupt1 -> ignore = YES ;
- ++nkill ;
- continue ;
- }
- for (k=0; k<nbad; ++k) {
- j = xbadbuff[k] ;
- snpm[j] -> ignore = YES ;
- ++nkill ;
- }
- }
- }
-
-
- free2D(&xx1, 10000) ;
- free(yy1) ;
- free(snpxl) ;
- free(gtypes) ;
- free(badbuff) ;
- free(xbadbuff) ;
- free(x1) ;
- free(x2) ;
-
- // re-initialize scores
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- cupt -> score = 0.0 ;
- }
-
- printf("killr2 complete\n") ;
- return nkill ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int vvadjust(double *cc, int n, double *pmean) {
- // take off mean force missing to zero
- // simpler version of vadjust
-
- double ynum, ysum, y, ymean ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum <= 1.5) {
- // no data or monomorphic
- vzero(cc, n) ;
- if (pmean != NULL) *pmean = ysum/(ynum+1.0e-8) ;
- return nmiss ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0)
- cc[i] = 0.0 ;
- else
- cc[i] -= ymean ;
- }
- if (pmean != NULL)
- *pmean = ymean ;
- return nmiss ;
-
-}
-
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-static int setskipit(char *sx) {
- int skipit = NO ;
- if (sx[0] == '#') skipit = YES ;
- if (strcmp(sx,"SNP_ID") == 0) skipit = YES ;
- if (strcmp(sx,"Indiv_ID") == 0) skipit = YES ;
- if (strcmp(sx,"Chr") == 0) skipit = YES ;
- return skipit ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int inpack2(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind) {
- // load up packed genotype file for merge.
-
- char **arrx, junk[10] ;
- int n, num, ihash, shash, i, g, j, k, t, g1, g2 ;
- int xihash, xshash, xnsnp, xnind ;
- int nind , nsnp, irec ;
- Indiv *indx ;
- SNP *cupt, *cupt2 ;
- SNP xsnp ;
- double y ;
- unsigned char *buff, *tbuff ;
- int fdes, ret ;
- char *packit, *pbuff ;
- int nbad = 0 ;
- n = numind ;
-
- ZALLOC(arrx, n, char *) ;
-
- // compute hashes to compare with file
- num = 0 ;
- for (i=0; i<n ; i++) {
- indx = indiv[i] ;
- arrx[num] = strdup(indx -> ID) ;
- ++num ;
- }
- ihash = hasharr(arrx, num) ;
- nind= num ;
-
- freeup(arrx, num) ;
- free(arrx) ;
-
- n = numsnps ;
- ZALLOC(arrx, n, char *) ;
- num = 0 ;
- for (i=0; i<n ; i++) {
- cupt = snpm[i] ;
- arrx[num] = strdup(cupt -> ID) ;
- ++num ;
- }
- shash = hasharr(arrx, num) ;
- nsnp = num ;
- freeup(arrx, num) ;
- free(arrx) ;
-
- // rlen is number of bytes each SNP's data requires in packed format
- y = (double) (nind * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
- ZALLOC(tbuff, rlen, unsigned char) ;
-
- // openfile and check readability
- fdes = open(gname, O_RDONLY) ;
- if (fdes<0) {
- perror("open failure") ;
- fatalx("(inpack2) bad open %s\n", gname) ;
- }
- t = read(fdes, buff, rlen ) ;
- if (t<0) {
- perror("read failure") ;
- fatalx("(inpack2) bad read") ;
- }
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
-
- if (xnind != nind) fatalx("(inpack2) nind mismatch %d %d \n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("(inpack2) nsnp mismatch\n") ;
- if (xihash != ihash) fatalx("(inpack2) ihash mismatch\n") ;
- if (xshash != shash) fatalx("(inpack2) shash mismatch\n") ;
-
-
- // now copy genotypes
- for (i=0; i<n ; i++) {
- t = read(fdes, tbuff, rlen) ;
- if (t != rlen) {
- perror("read failure") ;
- fatalx("(inpack2) bad data read") ;
- }
- cupt = snpm[i] ;
- if (cupt -> isfake) continue ;
- xsnp = *cupt ;
- cupt2 = &xsnp ;
- cupt2 -> pbuff = (char *) tbuff ;
- for (k=0; k<numind; ++k) {
- g2 = getgtypes(cupt2, k) ; // store in temporary buffer
- if (g2<0) continue ;
- g1 = getgtypes(cupt, k) ;
- if ( (g1>=0) && (g1 != g2)) ++nbad ; // inconsistent data
- putgtypes(cupt, k, g2) ;
- }
-
- // now check xhets
- for (k=0; k<numind; ++k) {
- if (cupt -> chrom != (numchrom+1)) break;
- indx = indiv[k] ;
- g = getgtypes(cupt, k) ;
- if (checkxval(cupt, indx, g) == NO) {
- putgtypes(cupt, k, -1) ;
- }
- }
- }
-
- free(buff) ;
- free(tbuff) ;
- close(fdes) ;
- return nbad ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void getgenos_list(char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers,
- int numsnps, int numindivs, int nignore) {
-
- char **fnames, *fn ;
- int n ;
- int k, nbad, isok ;
-
- dofreeped = NO ;
- n = numlines(genotypelist) ;
- ZALLOC(fnames, n, char *) ;
-
- // Read in list of genotype files
- n = getlist(genotypelist, fnames) ;
-
- // Load first one the ordinary way
- getgenos(fnames[0], snpmarkers, indivmarkers, numsnps, numindivs, nignore) ;
-
- // Load all others
- for (k=1; k<n; ++k) {
- fn = fnames[k] ;
- isok = NO ;
- if (ispack(fn)) {
- nbad = inpack2(fn, snpmarkers, indivmarkers, numsnps, numindivs) ;
- isok = YES ;
- }
- if (iseigenstrat(fn)) {
- nbad = ineigenstrat(fn, snpmarkers, indivmarkers, numsnps, numindivs) ;
- isok = YES ;
- }
- if (nbad>0) printf("%s genotypes mismatches: %d\n", fn, nbad) ;
- if (isok == NO) fatalx("file %s must be packed or eigenstrat format\n") ;
- }
-
- dofreeped = YES ;
- freeped() ;
-
- free(fnames) ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int setsdpos( SNPDATA *sdpt, int pos)
-{
- int t ;
- char ss[10], *sx ;
-
- sdpt -> ppos = pos ;
- strcpy(ss, sdpt -> cchrom) ;
- mkupper(ss) ;
-
- sdpt -> chimpfudge = chimpmode ;
-
- sx = strstr(ss, "CHR") ;
- if (sx != NULL) sx = ss+3 ;
- else sx = ss ;
-
- t = strcmp(sx, "2B") ;
- if (t==0) {
- sdpt -> ppos += 200000000 ;
- sdpt -> chimpfudge = YES ;
- }
- t = strcmp(sx, "2A") ;
- if (t==0) {
- sdpt -> chimpfudge = YES ;
- }
- return sdpt -> chimpfudge ;
-}
-
-int str2chrom(char *sss) {
- char ss[6] ;
- if (strlen(sss) > 5) fatalx("bad chrom: %s\n", sss) ;
- if (strstr(sss, "chr") != NULL) {
- strcpy(ss, sss+3) ;
- setchr(YES) ;
- }
- else (strcpy(ss, sss) ) ;
- mkupper(ss) ;
- if (strcmp(ss, "X") == 0) return (numchrom+1) ;
- if (strcmp(ss, "Y") == 0) return (numchrom+2) ;
- if (strcmp(ss, "MT") == 0) return MTCHROM ;
- if (strcmp(ss, "XY") == 0) return XYCHROM ;
- if (strcmp(ss, "2A") == 0) return 2 ;
- if (strcmp(ss, "2B") == 0) return 2 ;
- if (!isnumword(ss)) return -1 ;
- return atoi(ss) ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-int checksize(int numindivs, int numsnps, enum outputmodetype outputmode) {
- // -1 try packed format
-
- double y ;
- long z ;
-
- if (sizeof(z) == 8) checksizemode = NO ;
- if (checksizemode == NO) return 1 ;
-
- y = (double) numindivs ;
- y *= (double) numsnps ;
-
- if (y>8.0e9) return -2 ;
-
- switch (outputmode) {
-
- case ANCESTRYMAP:
- if (y>5.0e7) return -1 ;
- break ;
- case EIGENSTRAT:
- if (y>2.0e9) return -1 ;
- break ;
- case PED:
- if (y>4.0e8) return -1 ;
- break ;
- case PACKEDPED:
- break ;
- case PACKEDANCESTRYMAP:
- break ;
- default:
- fatalx("unknown outputmode\n") ;
- }
- return 1 ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int snprawindex(SNPDATA **snpraw, int nreal, char *sname) {
- int k ;
- char **ss ;
-
- freesnpindex() ;
-
- // if hash table is not set up, do it now
- if (snprawtab==NO) {
- snprawtab = YES ;
- ZALLOC(ss, nreal, char *) ;
- for (k=0; k< nreal; k++) {
- ss[k] = strdup(snpraw[k] -> ID) ;
- }
-
- // hash SNP data (key=SNP name, data=index in snpraw)
- xloadsearch(ss, nreal) ;
- freeup(ss, nreal) ;
- free(ss) ;
- }
-
- // return index in snpraw
- k = xfindit(sname) ;
- return k ;
-}
-
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void freesnprawindex() {
- if (snprawtab == NO) return ;
- snprawtab = NO ;
- xdestroy() ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void cntpops(int *count, Indiv **indm, int numindivs, char **eglist, int numeg) {
- // count number of samples for each pop
- Indiv *indx ;
- int t, k ;
-
- ivzero(count, numeg) ;
- for (k=0; k<numindivs; ++k) {
- indx = indm[k] ;
- if (indx -> ignore) continue ;
- t = indxindex(eglist, numeg, indx -> egroup) ;
- if (t<0) continue ;
- ++count[t] ;
- }
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-char *getpackgenos() {
- return packgenos ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void clearpackgenos() {
- packgenos = NULL ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void genocloseit(genofile *gfile) {
-
- genofile *gpt ;
- SNP *cupt ;
- int i ;
- gpt = gfile ;
-
- free(gpt -> buff) ;
- for (i=0; i< gpt -> numsnps; i++) {
- cupt = gpt -> snpm[i] ;
- freecupt(&cupt) ;
- }
- free(gpt -> snpm) ;
-
- for (i=0; i< gpt -> numindivs; i++) {
- free(gpt -> indivm[i]) ;
- }
- free(gpt -> indivm) ;
-
- close(gpt -> fdes) ;
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int genoopenit(genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m, int numsnp2, int numindiv2, int nignore) {
- // only one gfile can be open
- static genofile xfile ;
- genofile *gpt ;
- double y ;
- int rlen, fdes, t ;
- static unsigned char *buff ;
- int xihash, xshash, xnsnp, xnind ;
- int ihash, shash ;
- char *gname ;
- int nsnp, nind ;
-
-
- if (geno2name == NULL) fatalx("(genoopenit) null name\n") ;
- if (!ispack(geno2name)) fatalx("(genoopenit) not packed ancestrymap format\n") ;
- gpt = *gfile = &xfile ;
- strcpy(gpt -> gname, geno2name) ;
- gpt -> snpm = snp2m ;
- gpt -> indivm = indiv2m ;
- gpt -> numsnps = numsnp2 ;
- gpt -> numindivs = numindiv2 ;
-
- y = (double) (numindiv2 * 2) / (8 * (double) sizeof (char)) ;
- rlen = nnint(ceil(y)) ;
-
- gpt -> rlen = rlen ;
- rlen = MAX(rlen, 48) ;
- ZALLOC(buff, rlen, unsigned char) ;
- gpt -> buff = buff ;
-
- fdes = open(geno2name, O_RDONLY) ;
- if (fdes<0) return fdes ;
- gpt -> fdes = fdes ;
- gpt -> snpindex = -1 ;
-
- t = read(fdes, buff, rlen) ;
- if (t<0) fatalx("(genoopenit) bad initial read\n") ;
-
- nsnp = numsnp2 ;
- nind = numindiv2 ;
- gname = geno2name ;
-
- calcishash(snp2m, indiv2m, nsnp, nind, &ihash, &shash) ;
- if (hashcheck) {
- sscanf((char *) buff,"GENO %d %d %x %x", &xnind, &xnsnp, &xihash, &xshash) ;
- if (xnind != nind) fatalx("OOPS number of individuals %d != %d in input files\n", nind, xnind) ;
- if (xnsnp != nsnp) fatalx("OOPS number of SNPs %d != %d in input file: %s\n", nsnp, xnsnp, gname) ;
- if (xihash != ihash) fatalx("OOPS indiv file has changed since genotype file was created\n") ;
- if (xshash != shash) fatalx("OOPS snp file has changed since genotype file was created\n") ;
- }
-
- return 0 ;
-
-
-/* (Real definition is in admutils.h)
-
-typedef struct {
- char gname[IDSIZE] ;
- SNP **snpm ;
- Indiv **indivm ;
- int numsnps;
- int numindivs ;
- int rlen ;
- int fdes ;
- unsigned char *buff ;
- int snpindex ;
-} genofile ;
-*/
-
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-int genoreadit(genofile *gfile, SNP **pcupt) {
-/*
- return code
- < 0 bad read
- 0 EOF
- rlen good read
-*/
- genofile *gpt ;
- SNP *cupt ;
- int t, rlen, snum ;
- int k ;
-
- cupt = *pcupt = NULL ;
- gpt = gfile ;
- rlen = gpt -> rlen ;
- t = read(gpt -> fdes, gpt -> buff, rlen) ;
- if (t<0) fatalx("(genoreadit) bad read \n") ;
- if (t==0) return 0 ;
- if (t< gpt -> rlen) fatalx("(genoopenit) premature EOF\n") ;
- ++gpt -> snpindex ;
- snum = gpt -> snpindex ;
- cupt = *pcupt = gpt -> snpm[snum] ;
- cupt -> tagnumber = snum ;
- cupt -> pbuff = (char *) gpt -> buff ;
- cupt -> ngtypes = gpt -> numindivs ;
- if (cupt -> gtypes == NULL) ZALLOC(cupt -> gtypes, 1, int) ;
- return rlen ;
-}
-
-
-/* ---------------------------------------------------------------------------------------------------- */
-void putped(int num) {
- int *pp ;
- int t ;
-
- pp = snporda[num] ;
- if (pp != NULL) free(pp) ;
- pp = NULL ;
- t = numsnporda[num] = numsnpord ;
- if (t==0) return ;
- ZALLOC(snporda[num], t, int) ;
- pp = snporda[num] ;
- copyiarr(snpord, pp, t) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void getped(int num) {
- int *pp ;
- int t ;
-
- pp = snpord ;
- if (pp != NULL) free(pp) ;
- pp = NULL ;
- t = numsnpord = numsnporda[num] ;
- if (t==0) return ;
- ZALLOC(snpord, t, int) ;
- pp = snpord ;
- copyiarr(snporda[num], pp, t) ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void setbadpedignore() {
- badpedignore = YES ;
-}
-
-/* ---------------------------------------------------------------------------------------------------- */
-void logdeletedsnp(char *snpname, char *cmnt, char *deletesnpoutname) {
- if ( deletesnpoutname != NULL ) {
- FILE *fid = fopen(deletesnpoutname,"a");
- fprintf(fid, "%-40s %-40s\n", snpname, cmnt);
- fclose(fid);
- }
-}
-
-
-void sortsnps(SNP **snpa, SNP **snpb, int n)
-{
- SNP **tsnp, *cupt ;
- int **snppos, *snpindx ;
- int i, k ;
-
- snppos = initarray_2Dint(n, 3, 0) ;
- ZALLOC(snpindx, n, int) ;
- ZALLOC(tsnp, n, SNP *) ;
-
- for (i=0; i<n ; i++) {
- cupt = snpa[i] ;
- snppos[i][0] = cupt -> chrom ;
- snppos[i][1] = nnint((cupt -> genpos)*GDISMUL) ;
- snppos[i][2] = nnint(cupt -> physpos) ;
- }
-
- ZALLOC(snpindx, n, int) ;
- ipsortit(snppos, snpindx, n, 3) ;
-
- for (i=0; i<n; ++i) {
- k = snpindx[i] ;
- tsnp[i] = snpa[k] ;
- }
-
- for (i=0; i<n; ++i) {
- snpb[i] = tsnp[i] ;
- }
-
- free(snpindx) ;
- free2Dint(&snppos, n) ;
- free(tsnp) ;
-
-}
-
-
-
-
-
-
-
-
-
-
-
-/* doxygen documentation */
-
-/*! \fn int getsnps(char *snpfname, SNP ***snpmarkpt, double spacing,
- char *badsnpname, int *numignore, int numrisks)
-
- \brief Read SNP data from file
- \param snpfname File name (.snp or .map)
- \param snpmarkpt Pointer to array of type SNP * to store data in
- \param spacing
- \param badsnpname Name of file with list of SNPs to ignore (or NULL for none)
- \param numignore ???
- \param numrisks ???
-
- Returns number of SNPs loaded
- */
-
-
-/*! \fn int readsnpdata(SNPDATA **snpraw, char *fname)
- \brief Read SNP file
- \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
- \param fname Name of SNP file
-
- For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
- Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
- Also sets maxgpos[chrom] to highest genetic position in chromosome
- */
-
-
-/*! \fn int readsnpmapdata(SNPDATA **snpraw, char *fname)
- \brief Read PLINK format SNP file
- \param snpraw Array of (pointers to) type SNPDATA in which to temporarily store data
- \param fname Name of SNP file
-
- For each SNP read in, stores data in one element (SNPDATA *) of snpraw.
- Fills these elements of SNPDATA struct : inputrow (own index), chrom, gpos, ppos, alleles
- Also sets maxgpos[chrom] to highest genetic position in chromosome
- */
-
-
-/*! \fn getsizex(char *fname)
- \brief Count number of non-comment lines in file
- This is the number of SNPs in a .map or .snp file
- */
-
-/*! \fn int ismapfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .map file
- File is assumed to be PLINK if file extension is .map, .bim or .pedsnp
- */
-
-/*! \fn int ispedfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .ped file.
- File is assumed to be PLINK if file extension is .ped or .fam
- */
-
-/*! \fn int isbedfile(char *fname)
- \brief Look at file name to determine whether this is a PLINK .bed file.
- File is assumed to be PLINK if file extension is .ped or .fam
- */
-
-/*! \fn static int setskipit(char *sx)
- \brief Determine whether an input line from the SNP file should be skipped
- \param sx is the first token on the input line
- Skip if this is a comment or a line of column headers.
- /
-
-/*! \fn int numfakes(SNPDATA **snpraw, int *snpindx, int nreal, double spacing)
- \brief Return (approximate) number of fake SNPs that will be inserted
-
- Note: for EIGENSOFT programs, spacing is always set to 0.0 (presumably not for
- ANCESTRYMAP) which results in a return value of 0. The fake SNPs are inserted
- so that the genetic distance between adjacent SNPs is not greater than spacing.
- */
-
-/*! \fn double nextmesh(double val, double spacing)
- \brief Return least multiple of spacing greater than or equal to val
- (Used by numfakes and loadsnps to count number of fake SNPs.)
- */
-
-/*! \fn double interp (double l, double r, double x, double al, double ar)
- \brief Return linear interpolant a fractional x between the points (l,al) and (r, ar)
- */
-
-
-/*! \fn int getindivs(char *indivfname, Indiv ***indmarkpt)
- \brief Read individual data from file
- \param indivfname File name
- \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
- */
-
-/*! \fn int readindpeddata(Indiv **indivmarkers, char *fname) {
- \brief Read individual data from file
- \param indivfname File name
- \param indmarkpt Pointer to array of type Indiv * in which data is to be stored.
- */
-
-/*! \fn void pedname(char *cbuff, char *sx0, char *sx1)
- \brief Enforce name length requirements and prepend family names if desired.
- */
-
-
-/*! \fn int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname)
- Not used in EIGENSOFT
- */
-
-/*! \fn int readfreqdata(SNP **snpm, int numsnps, char *inddataname)
- Not used in EIGENSOFT
- */
-
-/*! \fn int setstatus(Indiv **indm, int numindivs, char *smatch)
- \brief Call setstatusv with value YES
- */
-
-/*! \fn int setstatusv(Indiv **indm, int numindivs, char *smatch, int val)
- \brief Set affstatus of all individuals with egroup equal to smatch to value val
- \param indm Array in which individuals' data is stored
- \param numindivs Number of individuals in the array
- \param smatch String in individual's field egroup to match
- \param val Value to set affstatus to
- */
-
-/*! \fn int checksize(int numindivs, int numsnps, enum outputmodetype outputmode)
- \brief Enforce size limits on genotype data file
- */
-
-/*! \fn int ispack(char *gname)
- \brief Open file and look for GENO at top. If it's there, the file is packed (binary)
- */
-
-/*! \fn int iseigenstrat(char *gname)
- \brief If every line in the file is one "word" (i.e., no white space), the file is
- assumed to be EIGENSTRAT format
- */
-
-/*! \fn long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from file
- \param genoname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
-
- Returns number of genotypes read
-
- Note: Instantiates, uses and destroys the hash table.
- */
-
-/*! \fn void genopedcnt(char *gname, int **gcounts, int nsnp)
- \brief Count number of alleles of each type in each SNP
-
- Return in gcounts[k][n] is number of "n" alleles in SNP k
-
- (This is used to discover and designate ref/var alleles)
-
- */
-
-/*! \fn void setgref(int **gcounts, int nsnp, int *gvar, int *gref)
- \brief Designate reference and variant alleles by looking at allele counts
-
- (This is for use with PED files)
-
- */
-
-/*! \fn long getgenos(char *genoname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from PLINK .ped format file
-
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
-
- Returns number of genotypes read
-
- Note: Instantiates, uses and destroys the hash table.
- */
-
-/*! \fn int getbedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read genotype data from PLINK .bed format file
-
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore ???
-
- Returns number of genotypes read
-
- Note: Instantiates, uses and destroys the hash table.
- */
-
- /*! \fn int inpack(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Read genotype data from packed ANCESTRYMAP format file
-
- \param gname Name of genotype data file
- \param snpmarkers Array in which SNP data is stored
- \param indivmarkers Array in which individual data is stored
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
-
- Returns number of genotypes read
-
- Note: Instantiates, uses and destroys the hash table.
- */
-
-/*! \fn void cleargdata(SNP **snpmarkers, int numsnps, int numindivs)
- \brief Wipe out all genotype data
- */
-
-/*! \fn rmindivs(SNP ** snpm, int numsnps, Indiv **indivmarkers, int numindivs)
- \brief squeeze out ignored individuals
-
- Return number of individuals retained (not ignored)
- */
-
-
-/*! \fn void freecupt(SNP **cuppt)
- \brief Free memory associated with SNP *
- */
-
-/*! \fn void clearind(Indiv **indm, int numind)
- \brief Re-initialize all individuals
- */
-
-/*! \fn void cleartg(indiv **indm, int nind
- \brief Zero out totgamms and totscore fields for all individuals
- */
-
-/*! \fn void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname)
- \brief Read badsnps file and set ignore flag on all bad SNPs
- \param snpraw Array of initial SNP data structs
- \param nreal Number of elements in snpraw
- \param badsnpname Name of badsnp file
- */
-
-/*! \fn void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids)
- \brief Print SNP output in EIGENSTRAT format
- */
-
-/*! \fn void printalleles(SNP *cupt, FILE *fff)
- \brief print SNP's alleles
- */
-
-/*! \fn void outfiles(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numindx, int packem, int ogmode)
- \brief Determine which output function to call based on user parameter outputmode
- \param snpname SNP output file name
- \param indname Individual output file name
- \param gname Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numindx Number of elements in indiv
- \param packem not used (used as local variable)
- \param ogmode flag for PED, print quantitative or group phenotype
- */
-
-/*! \fn void outpack(char *genooutfilename, SNP **snpm, Indiv **nindiv, int numsnps, int numind)
- \brief Print out genotype data in packed ANCESTRYMAP format
- \param genooutfilename Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
-*/
-
-/*! \fn void outeigenstrat(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind)
- \brief Print output in EIGENSTRAT format
- \param snpname SNP output file name
- \param indname Individual output name
- \param gname Genotype output name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
- */
-
-
-/*! \fn void outped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind, int ogmode)
- \brief Print output in (unpacked) PED format
-
- \param snpname SNP output file name
- \param indname Individual output file name
- \param gname Genotype output file name
- \param snpm Array with SNP data
- \param indiv Array with individual data
- \param numsnps Number of elements in snpm
- \param numind Number of individuals in indiv
- \param ogmode phenotype output mode (quantitative or discrete)
- */
-
-
-
-/*! \fn void gtox(int g, char *cvals, int *p1, int *p2)
- \brief Get alleles in PED format
- \param g Diploid genotype (0,1,2 or -1 for "missing")
- \param cvals Array with char ref and var alleles
- \param p1 Output for first allele
- \param p2 Output for second allele
-
- If cvals is NULL, return alleles "1" and "2" (i.e., "A" and "C")
- Otherwise, look up actual alleles. If the diploid is het, the alleles will be printed in the
- order (ref,var) not (var,ref)
- */
-
-/*! \fn void outindped(char *indname, Indiv **indiv, int numind, int ogmode)
- \brief Print out individual names in PEDIND format (i.e., first six or seven columns of PED)
- \param indname Individual output file name
- \param indiv Array with individual data
- \param numind Number of elements in indiv
- \param ogmode Flag for phenotype type (quantitative or discrete)
- */
-
-/*! \fn void outpackped(char *snpname, char *indname, char *gname, SNP **snpm, Indiv **indiv,
- int numsnps, int numind, int ogmode)
- \brief Print data in packed PED format (.bed)
- \param snpname Output SNP file name
- \param indname Output individual file name
- \param gname Output genotype file name
- \param snpm Array with SNP data
- \param indiv Array with individual data
- \param numsnps Number of elements in snpm
- \param numind Number of individuals in indiv
- \param ogmode Flag for phenotype type (quantitative or discrete)
- */
-
-
-/*! \fn void setbedbuff(char *buff, int *gtypes, int numind)
- \brief Fill buffer with diploid genotypes in BED format
- */
-
-
-/*! \fn void bedval(int g)
- \brief Encode diploid genotype into its packed BED equivalent
- */
-
-
-/*! \fn void atopchrom(char *ss, int chrom)
- \brief Encode integer chromosome number to its MAP file equivalent
- \param ss output chromosome symbol (0-22 or "X" or "Y") CHANGED 23 24
- \param chrom input chromosome symbol (0-24)
- */
-
-/*! \fn int ptoachrom(char *ss)
- \brief Encode MAP chromosome symbol to its numerical equivalent
- \param ss input chromosome symbol (0-22 or "X" or "Y")
-
- Return chromosome number (0-24)
- */
-
-
-/*! \fn void printmap(char *snpname, SNP **snpm, int numsnps, Indiv **indiv)
- \brief Print out SNP data in PLINK .map format
- \param snpname Output SNP file name
- \param snpm Array with SNP data
- \param numsnps Number of elements in snpm
- \param indiv not used
- */
-
-
-/*! \fn int calcishash(SNP **snpm, Indiv **indiv, int numsnps, int numind, int *pihash, int *pshash)
- \brief Calculate hashes on individuals and SNPs (to compare with file values.)
- \param snpm Array of SNP data
- \param indiv Array if individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
- \param pihash Output parameter for indiv hash
- \param pshash Output parameter for SNP hash
-
- Return number of SNPs plus number if individuals
- */
-
-/*! \fn void freeped(void)
- \brief destructor for array snpord
- */
-
-/*! \fn int readinddata(Indiv **indivmarkers, char *fname)
- \brief Read individual data from input file
- \param indivmarkers Array to store data in
- \param fname Individual input file
- */
-
-/*! \fn int readtldata(Indiv **indivmarkers, int numindivs, char *inddataname)
- \brief Read theta/lambda data (for ANCESTRYMAP, not used in EIGENSOFT)
- */
-
-/*! \fn int readfreqata(SNP **snpm, int numsnps, char *inddataname)
- \brief Read allele frequency data (for ANCESTRYMAP, not used in EIGENSOFT)
- */
-
-/*! \fn int checkxval(SNP *cupt, Indiv *indx, int val)
- \brief Check that male X marker is not (invalidly) heterozygous
- */
-
-/*! \fn void clearsnp(SNP *cupt)
- \brief Reinitialize all fields in SNP data structure
- */
-
-
-/*! \fn int rmindivs(SNP **snpm, int numsnps, Indiv **indivmarkers, int numindivs)
- \brief Squeeze out individuals with ignore flag set.
- \param snpm Array of SNP data
- \param numsnps Number of elements in snpm
- \param indivmarkers Array of individual data
- \param numindivs Number of elements in indivmarkers
- */
-
-
-/*! \fn int rmsnps(SNP **snpm, int numsnps)
- \brief Squeeze out SNPs with ignore flag set
- \param snpm Array of SNP data
- \param numsnps Number of elements in snpm
- */
-
-/*! \fn void freecupt(SNP **cuppt)
- \brief Free memory associated with SNP data structure
- */
-
-/*! \fn void clearind(Indiv **indm, int numind)
- \brief Free memory associated with all Indiv data structs in array
- */
-
-/*! \fn void cleartg(Indiv **indm, int nind)
- \brief Free memory in two fields of all Indiv data structs in array
- */
-
-/*! \fn void setug(Indiv **indm, int numind, char gender)
- \brief Set all unknown gender fields to value passed in
- */
-
-/*! \fn void dobadsnps(SNPDATA **snpraw, int nreal, char *badsnpname)
- \brief Remove bad SNPs from array
- \param snpraw Array of (preliminary) SNP data
- \param nreal Number of elements in snpraw
- \param badsnpname Bad SNP file name
-*/
-
-/*! \fn int checkfake(char **ss)
- \brief Returns YES if and only if string ss is "fake"
- */
-
-/*! \fn void printsnps(char *snpoutfilename, SNP **snpm, int num, Indiv **indm, int printfake, int printvalids)
- \brief Print ANCESTRYMAP format SNP file.
- \param snpoutfilename Name of SNP output file
- \param snpm Array with SNP data
- \param num Number of SNPs in array
- \param indm Array with individual data
- \param printfakes Flag to print fake SNPs
- \param printvalids Flag to print alleles
- */
-
-/*! \fn void printalleles(SNP *cupt, FILE *fff)
- \brief Print SNP alleles to file
- */
-
-/*! \fn void printdata(char *genooutfilename, char *indoutfilename, SNP **snpm,
- Indiv **indiv, int numsnps, int numind, int packem)
- \brief Print ANCESTRYMAP format genotype file
- \param genooutfilename Genotype output file name
- \param indoutfilename Individual output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
- \param packem Flag - print in packed mode if set
-*/
-
-/*! \fn void outpack(char *genooutfilename, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Print packed ANCESTRYMAP format genotype file
- \param genooutfilename Genotype output file name
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
-*/
-
-/*! \fn int ineigenstrat(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Read EIGENSTRAT genotype file
- \param gname Genotype input file
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of elements in snpm
- \param numind Number of elements in indiv
-
- Return number of errors encountered
-
- */
-
-/*! \fn void clearepath(char *packp)
- \brief Fill memory with 0xFF
- */
-
-
-/*! \fn void getsnpsc(char *snpscname, SNP **snpm, int numsnps)
- \brief Read SNP score input file (not used in EIGENSOFT)
- */
-
-/*! \fn void setepath(SNP **snpm, int nsnps)
- \brief Clear packed genotype memory (i.e., set to "missing") and point SNP buffers-pointers to the SNP's position in packed memory.
- */
-
-/*! \fn int getpedgenos(char *gname, SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int nignore)
- \brief Read PLINK format genotype file
- \param gname Name of genotype input file
- \param snpmarkers Array of SNP data
- \param indivmarkers Array of individual data
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore (not used)
- */
-
-
-/*! \fn void setgenotypename(char **gname, char *iname)
- \brief Copy PED genotypename from iname to *gname, checking that iname is not "NULL."
- */
-
-
-/*! \fn int maxlinelength(char *fname)
- \brief Find and return length of longest line in file
- */
-
-
-/*! \fn char x2base(int x)
- \brief Encode digit to char-type allele (PLINK convention)
- */
-
-/*! \fn int xpedval(char c)
- \brief Encode char-type allele to digit (PLINK convention)
- */
-
-/*! \fn int pedval(char *sx)
- \brief Encode char-type allele to digit (PLINK convention)
- */
-
-/*! \fn int ancval(int x)
- \brief Encode BED allele digit to ANCESTRYMAP equivalent
- */
-
-/*! \fn void setomode(enum outputmodetype *outmode, char *omode)
- \brief Set output mode from user parameter omode (default is packed ANCESTRYMAP)
- */
-
-/*! \fn void decimate(SNP **cbuff, int n, int decim, int mindis, int maxdis)
- \brief (Undocumented feature) Prune SNPs
-*/
-
-/*! \fn void snpdecimate(SNP **snpm, int nsnp, int decim, int mindis, int maxdis)
- \brief (Undocumented feature) Prune SNPs
-*/
-
-/*! \fn int killhir2(SNP **snpm, int numsnps, int numind, double physlim, double genlim, double rhothresh)
- \brief Remove one of each pair of SNPs with r-squared greater than rhothresh
- \param snpm Array of SNP data
- \param numsnps Number of SNPs in snpm
- \param numind Number of individuals in each SNP's genotype data
- \param physlim Only consider SNP pairs closer than this
- \param genlim Only consider SNP pairs closer than this
- \param rhothresh Maximum permissible r-squared value
-*/
-
-
-/*! \fn int vvadjust(double *cc, int n, double *pmean)
- \brief Mean-adjust data in array and force missing data to zero
- \param cc Array of values to mean-adjust
- \param n Number of values in array
- \param pmean Output parameter for returning the mean
- */
-
-
-/*! \fn int inpack2(char *gname, SNP **snpm, Indiv **indiv, int numsnps, int numind)
- \brief Load packed genotype file for merge of genotype files (used by getgenos_list)
- \param gname Name of input genotype file
- \param snpm Array of SNP data
- \param indiv Array of individual data
- \param numsnps Number of SNPs in snpm
- \param numind Number of individuals in indiv
- */
-
-
-/*! \fn void getgenos_list(char *genotypelist, SNP **snpmarkers, Indiv **indivmarkers, int numsnps,
- int numindivs, int nignore)
- \brief (Undocumented feature) Read in data from all genotype files in a list
- \param genotypelist File with names of genotype files in it
- \param snpmarkers Array of SNP data
- \param indivmarkers Array of individual data
- \param numsnps Number of SNPs in snpmarkers
- \param numindivs Number of individuals in indivmarkers
- \param nignore (not used)
- */
-
-
-/*! \fn int str2chrom(char *ss)
- \brief Encode string representation of chromosome to digit equivalent
- */
-
-
-/*! \fn int snprawindex(SNPDATA **snpraw, int nreal, char *sname)
- \brief Return index of SNP with name sname in array snpraw
- */
-
-
-/*! \fn void freesnprawindex()
- \brief Free hash table used to look up indices in snpraw
- */
-
-/*! \fn void cntpops(int *count, Indiv **indm, int numindivs, char **eglist, int numeg)
- \brief Count number of samples in each population
- \param count Array in which to store counts
- \param indm Array of individual data
- \param numindivs Number of individuals in indm
- \param eglist Array of population names
- \param numeg Number of individuals in eglist
- */
-
-/*! \fn int genoopenit(genofile **gfile, char *geno2name, SNP **snp2m, Indiv **indiv2m, int numsnp2,
- int numindiv2, int nignore)
- \brief Not used in EIGENSOFT (obsolete?)
- */
-
-/*! \fn int genoreadit(genofile *gfile, SNP **pcupt)
- \brief Not used in EIGENSOFT (obsolete?)
- */
-
-/*! \fn int putped(int num)
- \brief Store array snpord in snporda
- \param num Index in snporda in which to store copy of array
- */
-
-/*! \fn void getped(int num)
- \brief Copy array snpord from snporda
- \param num Index in snporda from which to copy array
- */
-
-/*! \fn int getweights(char *fname, SNP **snpm, int numsnps)
- \brief Read SNP weights from input file
- \param fname Weight file name
- \param snpm Array of SNP data
- \param numsnps Number of SNPs in snpm
- \return Number of weights set
- */
-
-
-void setchr(int mode)
-{
- chrmode = mode ;
-}
-
-void setchimpmode(int mode)
-{
- chimpmode = mode ;
-}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/src/pca.c b/src/pca.c
index 9d630f5..719cfe9 100644
--- a/src/pca.c
+++ b/src/pca.c
@@ -7,7 +7,8 @@
int MAXITER, K, TOPK, NSAMPLES, nSNP;
double SIGMATHRESH;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
int k, n, m, nn, rowvalid, *outlier, i;
int iter, nonewoutliers, nflags;
@@ -21,263 +22,328 @@ int main(int argc, char **argv)
char *LOGFILE = NULL;
/* set default values */
- K=10; MAXITER=5; TOPK=10; SIGMATHRESH=6.0;
+ K = 10;
+ MAXITER = 5;
+ TOPK = 10;
+ SIGMATHRESH = 6.0;
/* process flags */
nflags = 0;
- while((i = getopt(argc,argv,"i:k:o:e:l:m:t:s:")) != -1)
- {
- switch(i)
+ while ((i = getopt (argc, argv, "i:k:o:e:l:m:t:s:")) != -1)
{
- case 'i': /* input file */
- INFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'k':
- K = atoi(optarg); /* number of principal components to output */
- break;
- case 'o': /* output file */
- OUTFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'e': /* output eval file */
- EVALFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'l': /* log file */
- LOGFILE = (char *) strdup(optarg);
- nflags++; break;
- case 'm':
- MAXITER = atoi(optarg); /* max # of outlier removal iterations */
- break;
- case 't':
- TOPK = atoi(optarg); /* # of PCs along which to remove outliers */
- break;
- case 's':
- SIGMATHRESH = atof(optarg); /* # sdev to declare as outlier */
- break;
+ switch (i)
+ {
+ case 'i': /* input file */
+ INFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'k':
+ K = atoi (optarg); /* number of principal components to output */
+ break;
+ case 'o': /* output file */
+ OUTFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'e': /* output eval file */
+ EVALFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'l': /* log file */
+ LOGFILE = (char *) strdup (optarg);
+ nflags++;
+ break;
+ case 'm':
+ MAXITER = atoi (optarg); /* max # of outlier removal iterations */
+ break;
+ case 't':
+ TOPK = atoi (optarg); /* # of PCs along which to remove outliers */
+ break;
+ case 's':
+ SIGMATHRESH = atof (optarg); /* # sdev to declare as outlier */
+ break;
+ }
+ }
+ if (nflags != 4)
+ {
+ fprintf (stderr, "Usage: -i -o -e -l flags must all be specified\n");
+ exit (1);
}
- }
- if(nflags != 4)
- {
- fprintf(stderr,"Usage: -i -o -e -l flags must all be specified\n");
- exit(1);
- }
/* open output files */
- if( (fpout = fopen(OUTFILE, "w")) == NULL)
- {
- fprintf(stderr,"Could not open output file %s\n", OUTFILE); exit(1);
- }
- if( (fpeval = fopen(EVALFILE, "w")) == NULL)
- {
- fprintf(stderr,"Could not open output file %s\n", OUTFILE); exit(1);
- }
- if( (fplog = fopen(LOGFILE, "w")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", LOGFILE); exit(1);
- }
+ if ((fpout = fopen (OUTFILE, "w")) == NULL)
+ {
+ fprintf (stderr, "Could not open output file %s\n", OUTFILE);
+ exit (1);
+ }
+ if ((fpeval = fopen (EVALFILE, "w")) == NULL)
+ {
+ fprintf (stderr, "Could not open output file %s\n", OUTFILE);
+ exit (1);
+ }
+ if ((fplog = fopen (LOGFILE, "w")) == NULL)
+ {
+ fprintf (stderr, "Could not open input file %s\n", LOGFILE);
+ exit (1);
+ }
/* print parameters */
- fprintf(fplog,"pca program run using parameters\n");
- fprintf(fplog," -i %s\n",INFILE);
- fprintf(fplog," -k %d\n",K);
- fprintf(fplog," -o %s\n",OUTFILE);
- fprintf(fplog," -e %s\n",EVALFILE);
- fprintf(fplog," -l %s\n",LOGFILE);
- fprintf(fplog," -m %d\n",MAXITER);
- fprintf(fplog," -t %d\n",TOPK);
- fprintf(fplog," -s %.03f\n",SIGMATHRESH);
- fprintf(fplog,"\n");
+ fprintf (fplog, "pca program run using parameters\n");
+ fprintf (fplog, " -i %s\n", INFILE);
+ fprintf (fplog, " -k %d\n", K);
+ fprintf (fplog, " -o %s\n", OUTFILE);
+ fprintf (fplog, " -e %s\n", EVALFILE);
+ fprintf (fplog, " -l %s\n", LOGFILE);
+ fprintf (fplog, " -m %d\n", MAXITER);
+ fprintf (fplog, " -t %d\n", TOPK);
+ fprintf (fplog, " -s %.03f\n", SIGMATHRESH);
+ fprintf (fplog, "\n");
/* Determine NSAMPLES */
- if( (fp = fopen(INFILE, "r")) == NULL)
- {
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
- }
+ if ((fp = fopen (INFILE, "r")) == NULL)
+ {
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
+ }
n = 0;
- while(1)
- {
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '\n') break;
- n++;
- }
+ while (1)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '\n')
+ break;
+ n++;
+ }
NSAMPLES = n;
- fclose(fp);
- if(K > NSAMPLES-1)
- {
- fprintf(stderr,"OOPS k=%d is too large for only %d samples\n",K,NSAMPLES);
- fprintf(fplog,"OOPS k=%d is too large for only %d samples\n",K,NSAMPLES);
- exit(1);
- }
-
- /* malloc */
- if((eval = (double *) malloc(NSAMPLES*sizeof(*eval))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((evec = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*evec))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((outlier = (int *) malloc(NSAMPLES*sizeof(*outlier))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((sigmaoutlier = (double *) malloc(NSAMPLES*sizeof(*sigmaoutlier))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((X = (double *) malloc(NSAMPLES*sizeof(*X))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
- if((XTX = (double *) malloc(NSAMPLES*NSAMPLES*sizeof(*X))) == NULL)
- { fprintf(stderr,"CM\n"); exit(1); }
-
- nonewoutliers = 0;
- for(n=0; n<NSAMPLES; n++) outlier[n] = 0;
- iter = 0;
- while(nonewoutliers == 0)
- {
- for(n=0; n<NSAMPLES; n++) sigmaoutlier[n] = 0.0;
- /* initialize XTX */
- for(n=0; n<NSAMPLES; n++)
+ fclose (fp);
+ if (K > NSAMPLES - 1)
{
- for(nn=0; nn<NSAMPLES; nn++)
- XTX[NSAMPLES*n+nn] = 0.0;
+ fprintf (stderr, "OOPS k=%d is too large for only %d samples\n", K,
+ NSAMPLES);
+ fprintf (fplog, "OOPS k=%d is too large for only %d samples\n", K,
+ NSAMPLES);
+ exit (1);
}
- nonewoutliers = 1;
- /* get data */
- if( (fp = fopen(INFILE, "r")) == NULL)
+ /* malloc */
+ if ((eval = (double *) malloc (NSAMPLES * sizeof(*eval))) == NULL)
{
- fprintf(stderr,"Could not open input file %s\n", INFILE); exit(1);
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- m = 0;
- while(1) /* do EVERYTHING for SNP m */
+ if ((evec = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*evec))) == NULL)
{
- for(n=0; n<NSAMPLES; n++)
- {
- fscanf(fp,"%c",&Xchar);
- if(Xchar == '0') { X[n] = 0.0; }
- else if(Xchar == '1') { X[n] = 0.5; }
- else if(Xchar == '2') { X[n] = 1.0; }
- else if(Xchar == '9') { X[n] = -100.0; }
- else if(!(feof(fp)))
- {
- fprintf(stderr,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- fprintf(fplog,"OOPS bad char %c at m=%d n=%d\n",Xchar,m,n);
- exit(1);
- }
- if(outlier[n] == 1) X[n] = -100.0;
- }
- if(feof(fp)) break;
- fscanf(fp,"%c",&Xchar); /* should be \n character */
-
- /* mean-adjust this SNP */
- rowvalid = 0;
- rowsum = 0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(X[n] >= -99.0)
- {
- rowvalid++;
- rowsum += X[n];
- }
- }
- if(rowvalid > 0)
- {
- rowmean = (rowsum)/((double)(rowvalid));
- rowmeanbayes = (rowsum+0.5)/((double)(1+rowvalid));
- }
- for(n=0; n<NSAMPLES; n++)
- {
- if(X[n] >= -99.0)
- {
- X[n] -= rowmean;
- X[n] /= sqrt(rowmeanbayes*(1.0-rowmeanbayes));
- }
- else
- X[n] = 0.0;
- }
-
- /* update XTX */
- for(n=0; n<NSAMPLES; n++)
- {
- for(nn=n; nn<NSAMPLES; nn++)
- XTX[NSAMPLES*n+nn] += X[n]*X[nn];
- }
- m++;
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- nSNP = m;
- if(K > nSNP-1)
+ if ((outlier = (int *) malloc (NSAMPLES * sizeof(*outlier))) == NULL)
{
- fprintf(stderr,"OOPS k=%d is too large for only %d SNPs\n",K,nSNP);
- fprintf(fplog,"OOPS k=%d is too large for only %d SNPs\n",K,nSNP);
- exit(1);
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- if(iter == 0)
+ if ((sigmaoutlier = (double *) malloc (NSAMPLES * sizeof(*sigmaoutlier)))
+ == NULL)
{
- fprintf(fplog,"nSNP=%d NSAMPLES=%d\n",nSNP,NSAMPLES);
+ fprintf (stderr, "CM\n");
+ exit (1);
}
-
- /* complete XTX */
- for(n=0; n<NSAMPLES; n++)
+ if ((X = (double *) malloc (NSAMPLES * sizeof(*X))) == NULL)
{
- for(nn=n; nn<NSAMPLES; nn++)
- XTX[NSAMPLES*n+nn] /= ((double)nSNP);
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- for(n=0; n<NSAMPLES; n++)
+ if ((XTX = (double *) malloc (NSAMPLES * NSAMPLES * sizeof(*X))) == NULL)
{
- for(nn=0; nn<n; nn++)
- XTX[NSAMPLES*n+nn] = XTX[NSAMPLES*nn+n];
+ fprintf (stderr, "CM\n");
+ exit (1);
}
- /* do eigenanalysis */
- eigvecs(XTX, eval, evec, NSAMPLES); /* eigenvector k is evec[k*NSAMPLES+n] */
+ nonewoutliers = 0;
+ for (n = 0; n < NSAMPLES; n++)
+ outlier[n] = 0;
+ iter = 0;
+ while (nonewoutliers == 0)
+ {
+ for (n = 0; n < NSAMPLES; n++)
+ sigmaoutlier[n] = 0.0;
+ /* initialize XTX */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ for (nn = 0; nn < NSAMPLES; nn++)
+ XTX[NSAMPLES * n + nn] = 0.0;
+ }
- if(iter == MAXITER) break; /* no need to look for outliers */
+ nonewoutliers = 1;
+ /* get data */
+ if ((fp = fopen (INFILE, "r")) == NULL)
+ {
+ fprintf (stderr, "Could not open input file %s\n", INFILE);
+ exit (1);
+ }
+ m = 0;
+ while (1) /* do EVERYTHING for SNP m */
+ {
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ fscanf (fp, "%c", &Xchar);
+ if (Xchar == '0')
+ {
+ X[n] = 0.0;
+ }
+ else if (Xchar == '1')
+ {
+ X[n] = 0.5;
+ }
+ else if (Xchar == '2')
+ {
+ X[n] = 1.0;
+ }
+ else if (Xchar == '9')
+ {
+ X[n] = -100.0;
+ }
+ else if (!(feof(fp)))
+ {
+ fprintf (stderr, "OOPS bad char %c at m=%d n=%d\n", Xchar, m,
+ n);
+ fprintf (fplog, "OOPS bad char %c at m=%d n=%d\n", Xchar, m,
+ n);
+ exit (1);
+ }
+ if (outlier[n] == 1)
+ X[n] = -100.0;
+ }
+ if (feof(fp))
+ break;
+ fscanf (fp, "%c", &Xchar); /* should be \n character */
- /* find outliers */
- for(k=0; k<TOPK; k++)
- {
- sum=0.0; summ=0.0; sum1=0.0;
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n] == 1) continue;
- sum += evec[k*NSAMPLES+n];
- summ += evec[k*NSAMPLES+n]*evec[k*NSAMPLES+n];
- sum1 += 1.0;
- }
- mean = sum/sum1;
- sdev = sqrt(summ/sum1 - mean*mean);
- for(n=0; n<NSAMPLES; n++)
- {
- if(outlier[n] == 1) continue;
- sigma = (evec[k*NSAMPLES+n]-mean)/sdev;
- if(sigma < 0) sigma = -sigma;
- if(sigma > SIGMATHRESH)
- {
- if(sigma > sigmaoutlier[n]) sigmaoutlier[n] = sigma;
- nonewoutliers = 0;
+ /* mean-adjust this SNP */
+ rowvalid = 0;
+ rowsum = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (X[n] >= -99.0)
+ {
+ rowvalid++;
+ rowsum += X[n];
+ }
+ }
+ if (rowvalid > 0)
+ {
+ rowmean = (rowsum) / ((double) (rowvalid));
+ rowmeanbayes = (rowsum + 0.5) / ((double) (1 + rowvalid));
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (X[n] >= -99.0)
+ {
+ X[n] -= rowmean;
+ X[n] /= sqrt (rowmeanbayes * (1.0 - rowmeanbayes));
+ }
+ else
+ X[n] = 0.0;
+ }
+
+ /* update XTX */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ for (nn = n; nn < NSAMPLES; nn++)
+ XTX[NSAMPLES * n + nn] += X[n] * X[nn];
+ }
+ m++;
}
- }
- }
- fprintf(fplog,"Outlier removal iteration %d:\n",iter);
- if(nonewoutliers) fprintf(fplog," no outliers detected\n");
- for(n=0; n<NSAMPLES; n++)
- {
- if(sigmaoutlier[n] > 0.0)
- {
- fprintf(fplog," removed outlier individual %d (%.02f sigma)\n",n,sigmaoutlier[n]);
- outlier[n] = 1;
- }
+ nSNP = m;
+ if (K > nSNP - 1)
+ {
+ fprintf (stderr, "OOPS k=%d is too large for only %d SNPs\n", K,
+ nSNP);
+ fprintf (fplog, "OOPS k=%d is too large for only %d SNPs\n", K, nSNP);
+ exit (1);
+ }
+ if (iter == 0)
+ {
+ fprintf (fplog, "nSNP=%d NSAMPLES=%d\n", nSNP, NSAMPLES);
+ }
+
+ /* complete XTX */
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ for (nn = n; nn < NSAMPLES; nn++)
+ XTX[NSAMPLES * n + nn] /= ((double) nSNP);
+ }
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ for (nn = 0; nn < n; nn++)
+ XTX[NSAMPLES * n + nn] = XTX[NSAMPLES * nn + n];
+ }
+
+ /* do eigenanalysis */
+ eigvecs (XTX, eval, evec, NSAMPLES); /* eigenvector k is evec[k*NSAMPLES+n] */
+
+ if (iter == MAXITER)
+ break; /* no need to look for outliers */
+
+ /* find outliers */
+ for (k = 0; k < TOPK; k++)
+ {
+ sum = 0.0;
+ summ = 0.0;
+ sum1 = 0.0;
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n] == 1)
+ continue;
+ sum += evec[k * NSAMPLES + n];
+ summ += evec[k * NSAMPLES + n] * evec[k * NSAMPLES + n];
+ sum1 += 1.0;
+ }
+ mean = sum / sum1;
+ sdev = sqrt (summ / sum1 - mean * mean);
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (outlier[n] == 1)
+ continue;
+ sigma = (evec[k * NSAMPLES + n] - mean) / sdev;
+ if (sigma < 0)
+ sigma = -sigma;
+ if (sigma > SIGMATHRESH)
+ {
+ if (sigma > sigmaoutlier[n])
+ sigmaoutlier[n] = sigma;
+ nonewoutliers = 0;
+ }
+ }
+ }
+ fprintf (fplog, "Outlier removal iteration %d:\n", iter);
+ if (nonewoutliers)
+ fprintf (fplog, " no outliers detected\n");
+ for (n = 0; n < NSAMPLES; n++)
+ {
+ if (sigmaoutlier[n] > 0.0)
+ {
+ fprintf (fplog, " removed outlier individual %d (%.02f sigma)\n",
+ n, sigmaoutlier[n]);
+ outlier[n] = 1;
+ }
+ }
+ iter++;
+ fclose (fp);
}
- iter++;
- fclose(fp);
- }
/* print eval and evec */
- for(k=0; k<NSAMPLES; k++) fprintf(fpeval,"%.06f\n",eval[k]);
- fprintf(fpout,"%d\n",K);
- for(k=0; k<K; k++) fprintf(fpout,"%.04f\n",eval[k]);
- for(n=0; n<NSAMPLES; n++)
- {
- for(k=0; k<K; k++)
+ for (k = 0; k < NSAMPLES; k++)
+ fprintf (fpeval, "%.06f\n", eval[k]);
+ fprintf (fpout, "%d\n", K);
+ for (k = 0; k < K; k++)
+ fprintf (fpout, "%.04f\n", eval[k]);
+ for (n = 0; n < NSAMPLES; n++)
{
- fprintf(fpout," ");
- if(evec[k*NSAMPLES+n] > 0) fprintf(fpout," ");
- fprintf(fpout,"%.04f",evec[k*NSAMPLES+n]);
+ for (k = 0; k < K; k++)
+ {
+ fprintf (fpout, " ");
+ if (evec[k * NSAMPLES + n] > 0)
+ fprintf (fpout, " ");
+ fprintf (fpout, "%.04f", evec[k * NSAMPLES + n]);
+ }
+ fprintf (fpout, "\n");
}
- fprintf(fpout,"\n");
- }
return 0;
}
diff --git a/src/pcaselection.c b/src/pcaselection.c
new file mode 100644
index 0000000..1bc0a7a
--- /dev/null
+++ b/src/pcaselection.c
@@ -0,0 +1,344 @@
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <math.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#include <nicklib.h>
+#include <getpars.h>
+
+#include "badpairs.h"
+#include "admutils.h"
+#include "mcio.h"
+#include "mcmcpars.h"
+#include "globals.h"
+
+#include <gsl/gsl_matrix.h>
+#include <gsl/gsl_vector.h>
+
+#define WVERSION "1000"
+
+#define MAXFL 50
+#define MAXSTR 512
+#define MAXSIZE 8.0e9
+
+typedef enum outputmodetype inputmodetype;
+
+extern int packmode;
+extern int malexhet;
+extern int verbose;
+extern int plotmode;
+
+char *trashdir = "/var/tmp";
+int qtmode = NO;
+
+/* major data structures */
+Indiv **indivmarkers;
+SNP **snpmarkers;
+int numsnps, numindivs;
+
+char *genotypename = NULL; /* name of genotype file */
+char *snpname = NULL; /* name of SNP file */
+char *indivname = NULL; /* name of sample file */
+char *pcaname = NULL; /* name of pca file */
+char *imode = "eigenstrat"; /* input mode */
+char *outputname = NULL; /* name of output file */
+int numpc = 10; /* number of principal components
+ to correct */
+
+/*
+ If these are to be global, remove them from function parameter lists.
+ If they're going to be local, put the rest in (chisq routines)
+ */
+
+int NSAMPLES;
+int *outlier;
+int L;
+
+inputmodetype inmode;
+FILE *fpout; /* output file */
+
+void
+readcommands (int argc, char **argv);
+void
+setinmode (inputmodetype *inmode, char *imode);
+int
+read_evec (char *filename, double **eval, double **evec, size_t *K, size_t *N);
+
+int
+main (int argc, char **argv)
+{
+ size_t K, N;
+ int nignore;
+ double rowsum, rowsum1;
+ double chisq, Echisq, gamma, denom;
+
+ readcommands (argc, argv);
+ if (outputname != NULL)
+ openit (outputname, &fpout, "w");
+ else
+ fpout = stdout;
+ fprintf (fpout, "Chisq PCASELECTION\n");
+
+ setinmode (&inmode, imode);
+ packmode = YES;
+
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, NULL, &nignore, 1);
+
+ NSAMPLES = getindivs (indivname, &indivmarkers);
+
+ setstatus (indivmarkers, NSAMPLES, "Case");
+ setgenotypename (&genotypename, indivname);
+ if (genotypename != NULL)
+ {
+ getgenos (genotypename, snpmarkers, indivmarkers, numsnps, NSAMPLES,
+ nignore);
+ }
+
+ double *eval, *evec;
+
+ if (read_evec (pcaname, &eval, &evec, &K, &N) < 1)
+ {
+ printf ("Error reading evec file \"%s\".\n", pcaname);
+ return 1;
+ }
+
+ if (N != NSAMPLES)
+ {
+ printf ("Number of samples doesn't match: %d != %d", NSAMPLES, N);
+ return 1;
+ }
+
+ {
+ size_t i, j, k;
+ double *vg = (double *) malloc (k * sizeof(double));
+ double *v1 = (double *) malloc (k * sizeof(double));
+ for (i = 0; i < numsnps; i++)
+ {
+ N = 0;
+ double p = 0;
+
+ SNP *cupt = snpmarkers[i];
+
+ for (k = 0; k < K; k++)
+ {
+ vg[k] = 0;
+ v1[k] = 0;
+ }
+
+ for (j = 0; j < NSAMPLES; j++)
+ {
+ int g = getgtypes (cupt, j);
+
+ if (g >= 0)
+ {
+ N++;
+ p += g;
+ for (k = 0; k < K; k++)
+ {
+ vg[k] += evec[j * K + k] * g;
+ }
+ }
+
+ for (k = 0; k < K; k++)
+ {
+ v1[k] += evec[j * K + k];
+ }
+ }
+
+ p /= 2*N;
+
+ fprintf(fpout, "%s", cupt->ID);
+ for (k = 0; k < K; k++) {
+ vg[k] -= 2*p*v1[k];
+ vg[k] *= vg[k];
+ vg[k] /= 2*p*(1-p);
+ vg[k] /= eval[k];
+ fprintf(fpout, "\t%g", vg[k]);
+ }
+ fprintf(fpout, "\n");
+ }
+ }
+
+ return 0;
+}
+
+void
+readcommands (int argc, char **argv)
+{
+ int i;
+ char *parname = NULL;
+ phandle *ph;
+
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
+
+ switch (i)
+ {
+
+ case 'p':
+ parname = strdup (optarg);
+ break;
+
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
+
+ case 'V':
+ verbose = YES;
+ break;
+
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
+
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getint (ph, "packmode:", &packmode); // controls internals
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "pcaname:", &pcaname);
+ getstring (ph, "outputname:", &outputname);
+
+ writepars (ph);
+ closepars (ph);
+
+}
+
+void
+setinmode (inputmodetype *inmode, char *imode)
+{
+ char *ss = strdup (imode);
+ int len = strlen (ss);
+
+ int i;
+ for (i = 0; i < len; i++)
+ {
+ ss[i] = tolower(ss[i]);
+ }
+
+ *inmode = EIGENSTRAT; /* default */
+ if (strcmp (ss, "eigenstrat") == 0)
+ *inmode = EIGENSTRAT;
+ if (strcmp (ss, "ped") == 0)
+ *inmode = PED;
+ if (strcmp (ss, "packedped") == 0)
+ *inmode = PACKEDPED;
+ if (strcmp (ss, "ancestrymap") == 0)
+ *inmode = ANCESTRYMAP;
+ if (strcmp (ss, "packedancestrymap") == 0)
+ *inmode = PACKEDANCESTRYMAP;
+
+}
+
+int
+read_evec (char *filename, double **eval, double **evec, size_t *K, size_t *N)
+{
+ // OPEN THE FILE
+ FILE *fp = fopen (filename, "r");
+ if (fp == NULL)
+ {
+ printf ("File \"%s\" could not be opened.\n", filename);
+ return -1;
+ }
+
+ // READ THE "#eigvals:" FROM THE FIRST LINE
+ char buffer[256];
+ fscanf (fp, "%s", buffer);
+
+ if (strcmp (buffer, "#eigvals:") != 0)
+ {
+ printf ("File \"%s\" doesn't begin with \"#eigvals:\".\n", filename);
+ fclose (fp);
+ return -1;
+ }
+
+ // READ THE REST OF THE FIRST LINE OF THE FILE
+ char *line = NULL;
+ size_t red, len = 0;
+
+ red = getline (&line, &len, fp);
+
+ if (red < 1)
+ {
+ printf ("File \"%s\" appears to be empty.\n", filename);
+ fclose (fp);
+ return -1;
+ }
+
+ // COUNT THE EVALS AND PUT THEM INTO **eval
+ size_t k = 0;
+ {
+ double val;
+
+ char *pEnd = line;
+ while ((val = strtod (pEnd, &pEnd)) != 0.0)
+ {
+ k++;
+ }
+
+ *eval = (double *) malloc (k * sizeof(double));
+
+ pEnd = line;
+ size_t i;
+ for (i = 0; i < k; i++)
+ {
+ (*eval)[i] = strtod (pEnd, &pEnd);
+ }
+ }
+ free (line);
+
+ // COUNT THE LINES
+ size_t end_of_first_line = ftell (fp);
+ size_t n = 0;
+ char c = getc (fp);
+ while (c != EOF)
+ {
+ if (c == '\n')
+ {
+ n++;
+ }
+ c = getc (fp);
+ }
+
+ *K = k;
+ *N = n;
+
+ // READ EVEC
+ *evec = (double *) malloc (k * n * sizeof(double));
+
+ fseek (fp, end_of_first_line, 0);
+
+ {
+ size_t i;
+ for (i = 0; i < n; i++)
+ {
+ fscanf (fp, "%s", buffer);
+
+ line = NULL;
+ len = 0;
+ red = getline (&line, &len, fp);
+
+ char *pEnd = line;
+ size_t j;
+ for (j = 0; j < k; j++)
+ {
+ (*evec)[k * i + j] = strtod (pEnd, &pEnd);
+ }
+ free (line);
+ }
+ }
+
+ fclose (fp);
+ return (k);
+}
+
diff --git a/src/qpsubs.c b/src/qpsubs.c
index 22e095f..5255106 100644
--- a/src/qpsubs.c
+++ b/src/qpsubs.c
@@ -1,2451 +1,2725 @@
#include "qpsubs.h"
-extern int fancynorm, verbose, plotmode, outnum ;
-extern FILE *fstdetails ;
+extern int fancynorm, verbose, plotmode, outnum;
+extern FILE *fstdetails;
+
+static Indiv **indm;
+static void
+wjackestx (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g);
+static void
+wjackvestx (double *vest, double *var, int d, double *mean, double **jmean,
+ double *jwt, int g);
+static void
+calcndinbreed (int *c1, int *c2, double *pen, double *ped);
+static void
+calchetinbreed (int *c1, double *pen, double *ped);
+static int inbreed = NO;
-static Indiv **indm ;
-static void wjackestx(double *est, double *sig, double mean, double *jmean, double *jwt, int g) ;
-static void wjackvestx(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g) ;
-static void calcndinbreed(int *c1, int *c2, double *pen, double *ped) ;
-static void calchetinbreed(int *c1, double *pen, double *ped) ;
-static int inbreed = NO ;
-
-void printsc(int tpat[3][4], double tscore[3], char **eglist, double ymin)
-{
- int a, b, c, d ;
- int *tp, k ;
-
- tp = tpat[0] ;
- printf("qscore: ") ;
- a = tp[0] ; printf ("%15s ", eglist[a]) ;
- a = tp[1] ; printf ("%15s ", eglist[a]) ;
- printf(" ") ;
- a = tp[2] ; printf ("%15s ", eglist[a]) ;
- a = tp[3] ; printf ("%15s ", eglist[a]) ;
- for (k=0; k<3; k++) {
- tp = tpat[k] ;
- printf("%2d ", tp[0]) ;
- printf("%2d ", tp[1]) ;
- printf(" ") ;
- printf("%2d ", tp[2]) ;
- printf("%2d ", tp[3]) ;
- printf("%9.3f", tscore[k]) ;
- }
+void
+printsc (int tpat[3][4], double tscore[3], char **eglist, double ymin)
+{
+ int a, b, c, d;
+ int *tp, k;
+
+ tp = tpat[0];
+ printf ("qscore: ");
+ a = tp[0];
+ printf ("%15s ", eglist[a]);
+ a = tp[1];
+ printf ("%15s ", eglist[a]);
+ printf (" ");
+ a = tp[2];
+ printf ("%15s ", eglist[a]);
+ a = tp[3];
+ printf ("%15s ", eglist[a]);
+ for (k = 0; k < 3; k++)
+ {
+ tp = tpat[k];
+ printf ("%2d ", tp[0]);
+ printf ("%2d ", tp[1]);
+ printf (" ");
+ printf ("%2d ", tp[2]);
+ printf ("%2d ", tp[3]);
+ printf ("%9.3f", tscore[k]);
+ }
- printf (" %9.3f\n", ymin) ;
- printnl() ;
+ printf (" %9.3f\n", ymin);
+ printnl ();
}
-void xcopy(int rp[4], int a , int b, int c, int d)
+void
+xcopy (int rp[4], int a, int b, int c, int d)
{
- rp[0] = a ;
- rp[1] = b ;
- rp[2] = c ;
- rp[3] = d ;
-
+ rp[0] = a;
+ rp[1] = b;
+ rp[2] = c;
+ rp[3] = d;
}
void
-settsc(int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3])
+settsc (int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3])
/// process rscore and return scores in tscore with tscore[0] best
{
- double ww[3], w2[3], y ;
- double xmax, xmin ;
- int indx[3], i, k ;
-
- vvt(ww, rscore, rscore, 3) ;
- vmaxmin(ww, 3, &xmax, &xmin) ;
- vsp(ww, ww, -xmin, 3) ;
- copyarr(ww, w2, 3) ;
- vst(ww, ww, -1.0, 3) ;
- sortit(w2, indx, 3) ;
- y = w2[1] ; // second best score
- vsp(ww, ww, y, 3) ;
-
- for (i=0; i<3; i++) {
- k = indx[i] ;
- if (i==0) y = rscore[k] ;
- tscore[i] = ww[k] ;
- copyiarr(rpat[k], tpat[i], 4) ;
- }
-}
-
-void getpdata(int *rawcol, double *pm, double *pn, int *xtypes, int nrows, int numeg)
-{
- int *ytypes, n=0 ;
- int i, k, t, g ;
- double *data, y ;
-
- vzero(pm, numeg) ;
- vzero(pn, numeg) ;
-
- ZALLOC(ytypes, nrows, int) ;
- ZALLOC(data, nrows, double) ;
- for (k=0; k<nrows; ++k) {
- g = rawcol[k] ;
- t = xtypes[k] ;
- if (g<0) continue ;
- if (t<0) continue ;
- data[n] = g ;
- ytypes[n] = t ;
- ++n ;
- }
+ double ww[3], w2[3], y;
+ double xmax, xmin;
+ int indx[3], i, k;
+
+ vvt (ww, rscore, rscore, 3);
+ vmaxmin (ww, 3, &xmax, &xmin);
+ vsp (ww, ww, -xmin, 3);
+ copyarr (ww, w2, 3);
+ vst (ww, ww, -1.0, 3);
+ sortit (w2, indx, 3);
+ y = w2[1]; // second best score
+ vsp (ww, ww, y, 3);
+
+ for (i = 0; i < 3; i++)
+ {
+ k = indx[i];
+ if (i == 0)
+ y = rscore[k];
+ tscore[i] = ww[k];
+ copyiarr (rpat[k], tpat[i], 4);
+ }
+}
- if (n<=1) {
- free(ytypes) ;
- free(data) ;
- return ;
- }
- y = asum(data, n) / (double) n ;
-// vsp(data, data, -y, n) ;
+void
+getpdata (int *rawcol, double *pm, double *pn, int *xtypes, int nrows,
+ int numeg)
+{
+ int *ytypes, n = 0;
+ int i, k, t, g;
+ double *data, y;
+
+ vzero (pm, numeg);
+ vzero (pn, numeg);
+
+ ZALLOC(ytypes, nrows, int);
+ ZALLOC(data, nrows, double);
+ for (k = 0; k < nrows; ++k)
+ {
+ g = rawcol[k];
+ t = xtypes[k];
+ if (g < 0)
+ continue;
+ if (t < 0)
+ continue;
+ data[n] = g;
+ ytypes[n] = t;
+ ++n;
+ }
- y = 0.5*y ;
- y = y*(1.0-y) ;
+ if (n <= 1)
+ {
+ free (ytypes);
+ free (data);
+ return;
+ }
+ y = asum (data, n) / (double) n;
+// vsp(data, data, -y, n) ;
- if (y<.001) {
- free(ytypes) ;
- free(data) ;
- return ;
- }
+ y = 0.5 * y;
+ y = y * (1.0 - y);
- vst(data, data, 1.0/sqrt(y), n) ;
- for (i=0; i<n; i++) {
- t = ytypes[i] ;
- if (t<0) continue ;
- if (t>=numeg) continue ;
- pm[t] += data[i] ;
- pn[t] += 1.0 ;
+ if (y < .001)
+ {
+ free (ytypes);
+ free (data);
+ return;
}
- vsp(pn, pn, 1.0e-8, numeg) ;
- vvd(pm, pm, pn, numeg) ;
+ vst (data, data, 1.0 / sqrt (y), n);
+ for (i = 0; i < n; i++)
+ {
+ t = ytypes[i];
+ if (t < 0)
+ continue;
+ if (t >= numeg)
+ continue;
+ pm[t] += data[i];
+ pn[t] += 1.0;
+ }
- free(ytypes) ;
- free(data) ;
+ vsp (pn, pn, 1.0e-8, numeg);
+ vvd (pm, pm, pn, numeg);
+ free (ytypes);
+ free (data);
}
void
-gethscore(double *hscore, double *scores,
- int a, int b, int c, int d, int numeg)
+gethscore (double *hscore, double *scores, int a, int b, int c, int d,
+ int numeg)
{
- hscore[0] = qhdiff(scores, a, b, c, d, numeg) ;
- hscore[1] = qhdiff(scores, a, b, c, d, numeg) ;
- hscore[2] = qhdiff(scores, a, b, c, d, numeg) ;
+ hscore[0] = qhdiff (scores, a, b, c, d, numeg);
+ hscore[1] = qhdiff (scores, a, b, c, d, numeg);
+ hscore[2] = qhdiff (scores, a, b, c, d, numeg);
}
void
-getrscore(double *rscore, double *rho, double **zz,
- int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks)
+getrscore (double *rscore, double *rho, double **zz, int ncols, int a, int b,
+ int c, int d, int numeg, int *blabels, int nblocks)
{
- rscore[0] = qcorr(zz, &rho[0], ncols, a, b, c, d, numeg, blabels, nblocks) ;
- rscore[1] = qcorr(zz, &rho[1], ncols, a, c, b, d, numeg, blabels, nblocks) ;
- rscore[2] = qcorr(zz, &rho[2], ncols, a, d, b, c, numeg, blabels, nblocks) ;
+ rscore[0] = qcorr (zz, &rho[0], ncols, a, b, c, d, numeg, blabels, nblocks);
+ rscore[1] = qcorr (zz, &rho[1], ncols, a, c, b, d, numeg, blabels, nblocks);
+ rscore[2] = qcorr (zz, &rho[2], ncols, a, d, b, c, numeg, blabels, nblocks);
}
-double qhdiff(double *scores, int a, int b, int c, int d, int numeg)
+double
+qhdiff (double *scores, int a, int b, int c, int d, int numeg)
{
- double tt[4], xmax, xmin ;
- tt[0] = scores[a*numeg+c] ;
- tt[1] = scores[a*numeg+d] ;
- tt[2] = scores[b*numeg+c] ;
- tt[3] = scores[b*numeg+d] ;
- vmaxmin(tt, 4, &xmax, &xmin) ;
- return -(xmax-xmin) ;
+ double tt[4], xmax, xmin;
+ tt[0] = scores[a * numeg + c];
+ tt[1] = scores[a * numeg + d];
+ tt[2] = scores[b * numeg + c];
+ tt[3] = scores[b * numeg + d];
+ vmaxmin (tt, 4, &xmax, &xmin);
+ return -(xmax - xmin);
}
-double qcorr(double **zz, double *rho, int ncols, int a, int b, int c, int d, int numeg, int *blabels, int nblocks)
+double
+qcorr (double **zz, double *rho, int ncols, int a, int b, int c, int d,
+ int numeg, int *blabels, int nblocks)
{
- double *z1, *z2, y, xrho, xsig ;
- int u, v ;
+ double *z1, *z2, y, xrho, xsig;
+ int u, v;
- u = MIN(a, b) ;
- v = MAX(a, b) ;
- z1 = zz[u*numeg+v] ;
+ u = MIN(a, b);
+ v = MAX(a, b);
+ z1 = zz[u * numeg + v];
- u = MIN(c, d) ;
- v = MAX(c, d) ;
- z2 = zz[u*numeg+v] ;
+ u = MIN(c, d);
+ v = MAX(c, d);
+ z2 = zz[u * numeg + v];
- corrwjack(&xrho, &xsig, z1, z2, ncols, blabels, nblocks) ;
- *rho = xrho ;
- y = xrho/xsig ;
+ corrwjack (&xrho, &xsig, z1, z2, ncols, blabels, nblocks);
+ *rho = xrho;
+ y = xrho / xsig;
- return y ;
+ return y;
}
int
-loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs)
-{
- int i, n=0 ;
- Indiv *indx ;
- for (i=0; i<numindivs; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- if (indx -> affstatus == NO) continue ;
- xindex[n] = i ;
- if (xindlist != NULL) xindlist[n] = indx ;
- ++n ;
- }
- return n ;
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs)
+{
+ int i, n = 0;
+ Indiv *indx;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ if (indx->affstatus == NO)
+ continue;
+ xindex[n] = i;
+ if (xindlist != NULL)
+ xindlist[n] = indx;
+ ++n;
+ }
+ return n;
}
int
-loadsnpx(SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers)
-{
- int i, n=0 ;
- SNP *cupt ;
- for (i=0; i<numsnps; i++) {
- cupt = snpmarkers[i] ;
- if (cupt -> ignore) continue ;
- if (numvalidgt(indivmarkers, cupt) == 0) continue ;
- xsnplist[n] = cupt ;
- ++n ;
- }
- return n ;
+loadsnpx (SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers)
+{
+ int i, n = 0;
+ SNP *cupt;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->ignore)
+ continue;
+ if (numvalidgt (indivmarkers, cupt) == 0)
+ continue;
+ xsnplist[n] = cupt;
+ ++n;
+ }
+ return n;
}
void
-getrawcol(int *rawcol, SNP *cupt, int *xindex, int nrows)
+getrawcol (int *rawcol, SNP *cupt, int *xindex, int nrows)
{
- int t, j ;
- for (j=0; j< nrows; j++) {
- t = xindex[j] ;
- rawcol[j] = getgtypes(cupt, t) ;
+ int t, j;
+ for (j = 0; j < nrows; j++)
+ {
+ t = xindex[j];
+ rawcol[j] = getgtypes (cupt, t);
// if (verbose) printf("www %d %d %d\n", j, t, rawcol[j]) ;
- }
+ }
}
void
-getrawcolx(int **cc, SNP *cupt, int *xindex, int nrows, Indiv **indm)
-{
- int t, j, g, tt ;
- int *gg ;
- Indiv *indx ;
- static int ncall = 0 ;
-
- ++ncall ;
+getrawcolx (int **cc, SNP *cupt, int *xindex, int nrows, Indiv **indm)
+{
+ int t, j, g, tt;
+ int *gg;
+ Indiv *indx;
+ static int ncall = 0;
+
+ ++ncall;
// tt = strcmp(cupt -> ID, "rs10914979") ;
- tt = -1 ;
- for (j=0; j< nrows; j++) {
- t = xindex[j] ;
- gg = cc[j] ;
- ivclear(gg, -1, 2) ;
- g = getgtypes(cupt, t) ;
-
- if (g<0) continue ;
- gg[0] = g ; gg[1] = 2-g ;
- if (cupt -> chrom != 23) continue ;
- if (indm[t] -> gender != 'M') continue ;
- if (g==1) {
- ivclear(gg, -1, 2) ;
- continue ;
- }
- g = g/2 ;
- gg[0] = g ; gg[1] = 1-g ;
- }
+ tt = -1;
+ for (j = 0; j < nrows; j++)
+ {
+ t = xindex[j];
+ gg = cc[j];
+ ivclear (gg, -1, 2);
+ g = getgtypes (cupt, t);
+
+ if (g < 0)
+ continue;
+ gg[0] = g;
+ gg[1] = 2 - g;
+ if (cupt->chrom != 23)
+ continue;
+ if (indm[t]->gender != 'M')
+ continue;
+ if (g == 1)
+ {
+ ivclear (gg, -1, 2);
+ continue;
+ }
+ g = g / 2;
+ gg[0] = g;
+ gg[1] = 1 - g;
+ }
}
-
void
-getcolx(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolx (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- Indiv *indx ;
- int j, n, g, t ;
- double y, pmean, p ;
- int *rawcol ;
-
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- vadjust(xcol, nrows, &pmean) ;
- if (fancynorm) {
- p = 0.5*pmean ; // autosomes
- y = p * (1.0-p) ;
- if (y<=0.0) return ;
- y = 1.0/sqrt(y) ;
- vst(xcol, xcol, y, nrows) ;
- }
- else y = 1.0 ;
- if (xmean != NULL) {
- xmean[col] = pmean*y ;
- xfancy[col] = y ;
- }
- free(rawcol) ;
+ Indiv *indx;
+ int j, n, g, t;
+ double y, pmean, p;
+ int *rawcol;
+
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+
+ vadjust (xcol, nrows, &pmean);
+ if (fancynorm)
+ {
+ p = 0.5 * pmean; // autosomes
+ y = p * (1.0 - p);
+ if (y <= 0.0)
+ return;
+ y = 1.0 / sqrt (y);
+ vst (xcol, xcol, y, nrows);
+ }
+ else
+ y = 1.0;
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * y;
+ xfancy[col] = y;
+ }
+ free (rawcol);
}
void
-loadxdataind(double *xrow, SNP **snplist, int ind, int ncols)
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols)
{
- SNP *cupt ;
- Indiv *indx ;
- int i, j, k, n, g ;
+ SNP *cupt;
+ Indiv *indx;
+ int i, j, k, n, g;
- for (i=0; i<ncols; i++) {
- cupt = snplist[i] ;
- g = getgtypes(cupt, ind) ;
- xrow[i] = (double) g ;
- }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = snplist[i];
+ g = getgtypes (cupt, ind);
+ xrow[i] = (double) g;
+ }
}
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len)
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len)
{
- int i ;
+ int i;
- vvt(xrow, xrow, xfancy, len) ;
- for (i=0; i<len; i++) {
- if (xrow[i] < -0.1) xrow[i] = 0.0 ;
- else xrow[i] -= xmean[i] ;
+ vvt (xrow, xrow, xfancy, len);
+ for (i = 0; i < len; i++)
+ {
+ if (xrow[i] < -0.1)
+ xrow[i] = 0.0;
+ else
+ xrow[i] -= xmean[i];
}
}
-void dofancy(double *cc, int n, double *fancy)
-{
- int i, t, nmiss=0 ;
- int top, bot ;
- double p, yvar, y ;
+void
+dofancy (double *cc, int n, double *fancy)
+{
+ int i, t, nmiss = 0;
+ int top, bot;
+ double p, yvar, y;
+
+ top = bot = 0;
+ for (i = 0; i < n; i++)
+ {
+ t = nnint (cc[i]);
+ if (t < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ top += t;
+ bot += 2;
+ }
+ if (bot == 0)
+ return;
+ if (top == 0)
+ return;
+ if (top == bot)
+ return;
+ p = (double) top / ((double) bot);
+ yvar = p * (1.0 - p);
+ y = 1.0 / sqrt (yvar);
+ vst (cc, cc, y, n);
+ *fancy = y;
+}
- top = bot = 0 ;
- for (i=0; i<n; i++) {
- t = nnint(cc[i]) ;
- if (t<0) {
- ++nmiss ;
- continue ;
- }
- top += t ;
- bot += 2 ;
- }
- if (bot==0) return ;
- if (top == 0) return ;
- if (top == bot) return ;
- p = (double) top / ((double) bot) ;
- yvar = p*(1.0-p) ;
- y = 1.0/sqrt(yvar) ;
- vst(cc, cc, y, n ) ;
- *fancy = y ;
-}
-
-int vadjust(double *cc, int n, double *pmean)
+int
+vadjust (double *cc, int n, double *pmean)
/* take off mean force missing to zero */
{
- double ynum, ysum, y, ymean ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) fatalx("logic bug all missing\n") ;
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- return nmiss ;
-}
-
-double yll(double x1, double x2, double xlen)
-{
- double m1, m2, var ;
-
- if (xlen < 1.5 ) return 0.0 ;
- m1 = x1/xlen ;
- m2 = x2/xlen ;
- var = m2-m1*m1 ;
- if (var <= 0.0) fatalx("bad yll\n") ;
- return -0.5*xlen*log(var) ;
+ double ynum, ysum, y, ymean;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ fatalx ("logic bug all missing\n");
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ return nmiss;
+}
+
+double
+yll (double x1, double x2, double xlen)
+{
+ double m1, m2, var;
+
+ if (xlen < 1.5)
+ return 0.0;
+ m1 = x1 / xlen;
+ m2 = x2 / xlen;
+ var = m2 - m1 * m1;
+ if (var <= 0.0)
+ fatalx ("bad yll\n");
+ return -0.5 * xlen * log (var);
}
void
-calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg)
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1 ;
- double *w0, *popsize ;
+ int i, k;
+ double y1;
+ double *w0, *popsize;
- ZALLOC(w0, len, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- vzero(wmean, numeg) ;
+ vzero (wmean, numeg);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
-
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- free(w0) ;
- free(popsize) ;
+ free (w0);
+ free (popsize);
}
void
-setmiss(SNP **snpm, int numsnps)
-{
- SNP *cupt ;
- int i, j, t, n, tot ;
-
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- n = cupt -> ngtypes ;
- if (n <= 0) continue ;
- tot = 0 ;
- for (j=0; j<n; j++) {
- if (getgtypes (cupt, j) >= 0) {
- t = 1 ;
- }
- else {
- t = 0 ;
- }
- putgtypes(cupt, j, t) ;
- tot +=t ;
- }
- if (verbose)
- printf("Valids: %s %d\n", cupt -> ID, tot) ;
- }
+setmiss (SNP **snpm, int numsnps)
+{
+ SNP *cupt;
+ int i, j, t, n, tot;
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ n = cupt->ngtypes;
+ if (n <= 0)
+ continue;
+ tot = 0;
+ for (j = 0; j < n; j++)
+ {
+ if (getgtypes (cupt, j) >= 0)
+ {
+ t = 1;
+ }
+ else
+ {
+ t = 0;
+ }
+ putgtypes (cupt, j, t);
+ tot += t;
+ }
+ if (verbose)
+ printf ("Valids: %s %d\n", cupt->ID, tot);
+ }
}
void
-setfvecs(double *fvecs, double *evecs, int nrows, int numeigs)
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs)
// plotmode each eigenvector min 0 max 1
{
- double *w ;
- double xmax, xmin ;
- int i, j ;
+ double *w;
+ double xmax, xmin;
+ int i, j;
- ZALLOC(w, nrows, double) ;
+ ZALLOC(w, nrows, double);
- for (j=0; j<numeigs; j++) {
- copyarr(evecs+j*nrows, w, nrows) ;
- if (plotmode==NO) {
- vst(fvecs+j*nrows, w, 10.0, nrows) ;
- continue ;
+ for (j = 0; j < numeigs; j++)
+ {
+ copyarr (evecs + j * nrows, w, nrows);
+ if (plotmode == NO)
+ {
+ vst (fvecs + j * nrows, w, 10.0, nrows);
+ continue;
+ }
+ copyarr (w, fvecs + j * nrows, nrows);
}
- copyarr(w, fvecs+j*nrows, nrows) ;
- }
- free(w) ;
+ free (w);
}
-void countpops(int ***counts, SNP **xsnplist, int *xindex, int *xtypes, int nrows, int ncols)
+void
+countpops (int ***counts, SNP **xsnplist, int *xindex, int *xtypes, int nrows,
+ int ncols)
// countpops is int [ncols][npops][2] already zero filled
{
- int col, i, g1, g2, g, k1 ;
- SNP *cupt ;
- int *rawcol ;
-
- ZALLOC(rawcol, nrows, int) ;
- for (col = 0; col < ncols; ++col) {
- cupt = xsnplist[col] ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (i=0; i<nrows; i++) {
- g = rawcol[i] ;
- k1 = xtypes[i] ;
- if (k1<0) continue ;
- if (g<0) continue ;
- g1 = 0 ;
- if (g>0) g1 = 1 ;
- g2 = g-g1 ;
- if (g1<0) fatalx("bug\n") ;
- if (g2<0) fatalx("bug\n") ;
- if (g1>1) fatalx("bug\n") ;
- if (g2>1) fatalx("bug\n") ;
- ++counts[col][k1][g1] ;
- ++counts[col][k1][g2] ;
- }
- }
- free(rawcol) ;
+ int col, i, g1, g2, g, k1;
+ SNP *cupt;
+ int *rawcol;
+
+ ZALLOC(rawcol, nrows, int);
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (i = 0; i < nrows; i++)
+ {
+ g = rawcol[i];
+ k1 = xtypes[i];
+ if (k1 < 0)
+ continue;
+ if (g < 0)
+ continue;
+ g1 = 0;
+ if (g > 0)
+ g1 = 1;
+ g2 = g - g1;
+ if (g1 < 0)
+ fatalx ("bug\n");
+ if (g2 < 0)
+ fatalx ("bug\n");
+ if (g1 > 1)
+ fatalx ("bug\n");
+ if (g2 > 1)
+ fatalx ("bug\n");
+ ++counts[col][k1][g1];
+ ++counts[col][k1][g2];
+ }
+ }
+ free (rawcol);
}
-
-
// setidmat used to scale
-void fixrho (double *a, int n)
+void
+fixrho (double *a, int n)
// turn a into correlation matrix
{
- double *d, *tt, y ;
- int i ;
-
- ZALLOC(d, n, double) ;
- ZALLOC(tt, n*n, double) ;
-
- getdiag(d, a, n) ;
+ double *d, *tt, y;
+ int i;
- vsqrt(d, d, n) ;
- addouter(tt, d, n) ;
+ ZALLOC(d, n, double);
+ ZALLOC(tt, n*n, double);
- vvd(a, a, tt, n*n) ;
+ getdiag (d, a, n);
+ vsqrt (d, d, n);
+ addouter (tt, d, n);
- free(d) ;
- free(tt) ;
+ vvd (a, a, tt, n * n);
+ free (d);
+ free (tt);
}
-void printdiag(double *a, int n)
+void
+printdiag (double *a, int n)
{
- double *d, *tt, y ;
- int i ;
+ double *d, *tt, y;
+ int i;
- ZALLOC(d, n, double) ;
- getdiag(d, a, n) ;
- y = asum(d,n) / (double) n ;
- for (i=0; i<n; i++) {
- printf("diag: %9.3f\n", d[i]/y) ;
+ ZALLOC(d, n, double);
+ getdiag (d, a, n);
+ y = asum (d, n) / (double) n;
+ for (i = 0; i < n; i++)
+ {
+ printf ("diag: %9.3f\n", d[i] / y);
}
-
- free(d) ;
- abort() ;
+ free (d);
+ abort ();
}
void
-addoutersym(double *X, double *v, int n)
+addoutersym (double *X, double *v, int n)
{
- int i, j ;
+ int i, j;
- for (i=0; i<n; i++) {
- for (j=i; j<n; j++) {
- X[i*n+j] += v[i]*v[j] ;
+ for (i = 0; i < n; i++)
+ {
+ for (j = i; j < n; j++)
+ {
+ X[i * n + j] += v[i] * v[j];
+ }
}
- }
}
-void symit(double *X, int n)
+void
+symit (double *X, int n)
{
- int i, j ;
+ int i, j;
- for (i=0; i<n; i++) {
- for (j=i+1; j<n; j++) {
- X[j*n+i] = X[i*n+j] ;
+ for (i = 0; i < n; i++)
+ {
+ for (j = i + 1; j < n; j++)
+ {
+ X[j * n + i] = X[i * n + j];
+ }
}
- }
}
-double divcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+divcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
/* heterozygosity for 2 pops */
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
-
-
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0; /* no data */
- free(rawcol) ;
- return 0.0;
- }
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0; /* no data */
+ free (rawcol);
+ return 0.0;
+ }
- en = ya*ybb + yb*yaa ;
- ed = z*zz ;
+ en = ya * ybb + yb * yaa;
+ ed = z * zz;
- *estn = en ;
- *estd = ed ;
-
+ *estn = en;
+ *estd = ed;
- free(rawcol) ;
- return z + zz ;
+ free (rawcol);
+ return z + zz;
}
-void f3y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3)
-{
- int c1[2], c2[2], c3[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, p3, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
-
-
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
- ivzero(c3, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (k==type3) cc = c3 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
+void
+f3y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3)
+{
+ int c1[2], c2[2], c3[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+ ivzero (c3, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (k == type3)
+ cc = c3;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- z = ya + yb ;
+ ya = a = c1[0];
+ yb = b = c1[1];
+ z = ya + yb;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yaa = c2[0];
+ ybb = c2[1];
+ yt = yaa + ybb;
+ p2 = yaa / yt;
- yaa = c2[0] ;
- ybb = c2[1] ;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
+ yaa = c3[0];
+ ybb = c3[1];
+ yt = yaa + ybb;
+ p3 = yaa / yt;
- yaa = c3[0] ;
- ybb = c3[1] ;
- yt = yaa+ybb ;
- p3 = yaa/yt ;
+ en = (p1 - p2) * (p1 - p3);
+ en -= h1 / z;
- en = (p1-p2)*(p1-p3) ;
- en -= h1/z ;
-
- *estn = en ;
-
+ *estn = en;
- free(rawcol) ;
+ free (rawcol);
}
-void f2sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3)
+void
+f2sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3)
// processes X chromosome correctly
{
- int c1[2], c2[2], c3[2], c4[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed ;
- double z, zz, h1, h2, h3, yt ;
- double z2, z3 ;
- double ywt ;
- int **ccc, *ccpt[3] ;
-
-
- ccc = initarray_2Dint(nrows, 2, 0) ;
+ int c1[2], c2[2], c3[2], c4[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
+ double z, zz, h1, h2, h3, yt;
+ double z2, z3;
+ double ywt;
+ int **ccc, *ccpt[3];
+ ccc = initarray_2Dint (nrows, 2, 0);
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
- ivzero(c3, 2) ;
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+ ivzero (c3, 2);
- ccpt[0] = c1 ;
- ccpt[1] = c2 ;
- ccpt[2] = c3 ;
+ ccpt[0] = c1;
+ ccpt[1] = c2;
+ ccpt[2] = c3;
- *estn = 0 ;
- *estd = -1 ;
+ *estn = 0;
+ *estd = -1;
- for (i=0; i< nrows; i++) {
+ for (i = 0; i < nrows; i++)
+ {
- k = xtypes[i] ;
- cc = NULL ;
+ k = xtypes[i];
+ cc = NULL;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (k==type3) cc = c3 ;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (k == type3)
+ cc = c3;
- if (cc == NULL) continue ;
+ if (cc == NULL)
+ continue;
- g = ccc[i][0] ;
- if (g<0) continue ;
- cc[0] += g ;
- g = ccc[i][1] ;
- cc[1] += g ;
-
- }
+ g = ccc[i][0];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ g = ccc[i][1];
+ cc[1] += g;
+ }
-/**
+ /**
printf("qq1: %d ", cupt -> markernum) ;
printimat(c1, 1, 2) ;
-*/
-
- for (i=0; i<=2; i++) {
- cc = ccpt[i] ;
- a = intsum(cc,2) ;
- if (a<2) {
- free2Dint(&ccc, nrows) ;
- return ;
+ */
+
+ for (i = 0; i <= 2; i++)
+ {
+ cc = ccpt[i];
+ a = intsum (cc, 2);
+ if (a < 2)
+ {
+ free2Dint (&ccc, nrows);
+ return;
+ }
}
- }
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- z = ya + yb ;
+ ya = a = c1[0];
+ yb = b = c1[1];
+ z = ya + yb;
+ yt = ya + yb;
+ p1 = ya / yt;
- yt = ya+yb ;
- p1 = ya/yt ;
+ h1 = ya * yb / (yt * (yt - 1.0));
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yaa = c2[0];
+ ybb = c2[1];
+ z2 = yt = yaa + ybb;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+ p2 = yaa / yt;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z2 = yt = yaa+ybb ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
- p2 = yaa/yt ;
-
- yaa = c3[0] ;
- ybb = c3[1] ;
- z3 = yt = yaa+ybb ;
- h3 = yaa*ybb/(yt*(yt-1.0)) ;
- p3 = yaa/yt ;
+ yaa = c3[0];
+ ybb = c3[1];
+ z3 = yt = yaa + ybb;
+ h3 = yaa * ybb / (yt * (yt - 1.0));
+ p3 = yaa / yt;
// h1 0 is OK trap if necessary in calling program
- en = (p2-p3)*(p2-p3) ;
- en -= h2/z2 ;
- en -= h3/z3 ;
+ en = (p2 - p3) * (p2 - p3);
+ en -= h2 / z2;
+ en -= h3 / z3;
+
+ if (isnan(en))
+ fatalx ("f3 bug\n");
- if (isnan(en)) fatalx("f3 bug\n") ;
-
- *estn = en ;
- *estd = 2.0*h1 ;
-
+ *estn = en;
+ *estd = 2.0 * h1;
- free2Dint(&ccc, nrows) ;
+ free2Dint (&ccc, nrows);
}
-void f3sc(double *estn, double *estd, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3)
+void
+f3sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
+ int *xtypes, int nrows, int type1, int type2, int type3)
// processes X chromosome correctly
{
- int c1[2], c2[2], c3[2], c4[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed ;
- double z, zz, h1, yt ;
- double ywt ;
- int **ccc, *ccpt[3] ;
-
-
- ccc = initarray_2Dint(nrows, 2, 0) ;
-
+ int c1[2], c2[2], c3[2], c4[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
+ double z, zz, h1, yt;
+ double ywt;
+ int **ccc, *ccpt[3];
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
+ ccc = initarray_2Dint (nrows, 2, 0);
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
- ivzero(c3, 2) ;
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
- ccpt[0] = c1 ;
- ccpt[1] = c2 ;
- ccpt[2] = c3 ;
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+ ivzero (c3, 2);
- *estn = 0 ;
- *estd = -1 ;
+ ccpt[0] = c1;
+ ccpt[1] = c2;
+ ccpt[2] = c3;
- for (i=0; i< nrows; i++) {
+ *estn = 0;
+ *estd = -1;
- k = xtypes[i] ;
- cc = NULL ;
+ for (i = 0; i < nrows; i++)
+ {
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (k==type3) cc = c3 ;
+ k = xtypes[i];
+ cc = NULL;
- if (cc == NULL) continue ;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (k == type3)
+ cc = c3;
- g = ccc[i][0] ;
- if (g<0) continue ;
- cc[0] += g ;
- g = ccc[i][1] ;
- cc[1] += g ;
+ if (cc == NULL)
+ continue;
- }
+ g = ccc[i][0];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ g = ccc[i][1];
+ cc[1] += g;
+ }
-/**
+ /**
printf("qq1: %d ", cupt -> markernum) ;
printimat(c1, 1, 2) ;
-*/
-
- for (i=0; i<=2; i++) {
- cc = ccpt[i] ;
- a = intsum(cc,2) ;
- if (a<2) {
- free2Dint(&ccc, nrows) ;
- return ;
+ */
+
+ for (i = 0; i <= 2; i++)
+ {
+ cc = ccpt[i];
+ a = intsum (cc, 2);
+ if (a < 2)
+ {
+ free2Dint (&ccc, nrows);
+ return;
+ }
}
- }
-
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- z = ya + yb ;
+ ya = a = c1[0];
+ yb = b = c1[1];
+ z = ya + yb;
- yt = ya+yb ;
- p1 = ya/yt ;
+ yt = ya + yb;
+ p1 = ya / yt;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yaa = c2[0] ;
- ybb = c2[1] ;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
+ yaa = c2[0];
+ ybb = c2[1];
+ yt = yaa + ybb;
+ p2 = yaa / yt;
- yaa = c3[0] ;
- ybb = c3[1] ;
- yt = yaa+ybb ;
- p3 = yaa/yt ;
+ yaa = c3[0];
+ ybb = c3[1];
+ yt = yaa + ybb;
+ p3 = yaa / yt;
// h1 0 is OK trap if necessary in calling program
- en = (p1-p2)*(p1-p3) ;
- en -= h1/z ;
+ en = (p1 - p2) * (p1 - p3);
+ en -= h1 / z;
- if (isnan(en)) fatalx("f3 bug\n") ;
-
- *estn = en ;
- *estd = 2.0*h1 ;
-
+ if (isnan(en))
+ fatalx ("f3 bug\n");
- free2Dint(&ccc, nrows) ;
+ *estn = en;
+ *estd = 2.0 * h1;
+
+ free2Dint (&ccc, nrows);
}
-void f4yx(double *estn, SNP *cupt, Indiv **indm,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4)
+void
+f4yx (double *estn, SNP *cupt, Indiv **indm, int *xindex, int *xtypes,
+ int nrows, int type1, int type2, int type3, int type4)
// processes X chromosome correctly
{
- int c1[2], c2[2], c3[2], c4[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
- int **ccc ;
-
-
- ccc = initarray_2Dint(nrows, 2, 0) ;
-
-
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
- ivzero(c3, 2) ;
- ivzero(c4, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
-
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (k==type3) cc = c3 ;
- if (k==type4) cc = c4 ;
-
- if (cc == NULL) continue ;
+ int c1[2], c2[2], c3[2], c4[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+ int **ccc;
+
+ ccc = initarray_2Dint (nrows, 2, 0);
+
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+ ivzero (c3, 2);
+ ivzero (c4, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (k == type3)
+ cc = c3;
+ if (k == type4)
+ cc = c4;
+
+ if (cc == NULL)
+ continue;
+
+ g = ccc[i][0];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ g = ccc[i][1];
+ cc[1] += g;
+ }
- g = ccc[i][0] ;
- if (g<0) continue ;
- cc[0] += g ;
- g = ccc[i][1] ;
- cc[1] += g ;
- }
+ ya = a = c1[0];
+ yb = b = c1[1];
+ z = ya + yb;
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- z = ya + yb ;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
+ yaa = c2[0];
+ ybb = c2[1];
+ yt = yaa + ybb;
+ p2 = yaa / yt;
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yaa = c3[0];
+ ybb = c3[1];
+ yt = yaa + ybb;
+ p3 = yaa / yt;
- yaa = c2[0] ;
- ybb = c2[1] ;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
+ yaa = c4[0];
+ ybb = c4[1];
+ yt = yaa + ybb;
+ p4 = yaa / yt;
+ en = (p1 - p2) * (p3 - p4);
- yaa = c3[0] ;
- ybb = c3[1] ;
- yt = yaa+ybb ;
- p3 = yaa/yt ;
+ *estn = en;
- yaa = c4[0] ;
- ybb = c4[1] ;
- yt = yaa+ybb ;
- p4 = yaa/yt ;
- en = (p1-p2)*(p3-p4) ;
-
- *estn = en ;
-
- free2Dint(&ccc, nrows) ;
+ free2Dint (&ccc, nrows);
}
+void
+f4y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
+ int type2, int type3, int type4)
+{
+ int c1[2], c2[2], c3[2], c4[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+ ivzero (c3, 2);
+ ivzero (c4, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (k == type3)
+ cc = c3;
+ if (k == type4)
+ cc = c4;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
-void f4y(double *estn, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2, int type3, int type4)
-{
- int c1[2], c2[2], c3[2], c4[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
-
-
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
- ivzero(c3, 2) ;
- ivzero(c4, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (k==type3) cc = c3 ;
- if (k==type4) cc = c4 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
-
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- z = ya + yb ;
+ ya = a = c1[0];
+ yb = b = c1[1];
+ z = ya + yb;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yaa = c2[0];
+ ybb = c2[1];
+ yt = yaa + ybb;
+ p2 = yaa / yt;
- yaa = c2[0] ;
- ybb = c2[1] ;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
+ yaa = c3[0];
+ ybb = c3[1];
+ yt = yaa + ybb;
+ p3 = yaa / yt;
- yaa = c3[0] ;
- ybb = c3[1] ;
- yt = yaa+ybb ;
- p3 = yaa/yt ;
+ yaa = c4[0];
+ ybb = c4[1];
+ yt = yaa + ybb;
+ p4 = yaa / yt;
+ en = (p1 - p2) * (p3 - p4);
- yaa = c4[0] ;
- ybb = c4[1] ;
- yt = yaa+ybb ;
- p4 = yaa/yt ;
- en = (p1-p2)*(p3-p4) ;
-
- *estn = en ;
-
+ *estn = en;
- free(rawcol) ;
+ free (rawcol);
}
-void fstcolinb(double *estnmat, double *estdmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg)
+void
+fstcolinb (double *estnmat, double *estdmat, SNP *cupt, int *xindex,
+ int *xtypes, int nrows, int numeg)
/**
- NP style n, d estimation for inbreeding, Like fstcolyy
+ NP style n, d estimation for inbreeding, Like fstcolyy
like fstcoly but a matrix of populations so data is only accessed once
-*/
-{
- int *c1, *c2, *cc ;
- int *rawcol ;
- int k, g, i, j, a, b ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
- int **ccc, *gg, **ddd ;
- static int ncall = 0 ;
- double het, hetin ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ddd = initarray_2Dint(numeg, 3, 0) ;
-
-
-
- vzero(estnmat, numeg) ;
- vclear(estdmat, -1.0, numeg) ;
-
- if (indm == NULL) {
- ZALLOC(rawcol, nrows, int) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (a=0; a<nrows; a++) {
- g = rawcol[a] ;
- ccc[a][0] = g ;
- ccc[a][1] = 2-g ;
+ */
+{
+ int *c1, *c2, *cc;
+ int *rawcol;
+ int k, g, i, j, a, b;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+ int **ccc, *gg, **ddd;
+ static int ncall = 0;
+ double het, hetin;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ddd = initarray_2Dint (numeg, 3, 0);
+
+ vzero (estnmat, numeg);
+ vclear (estdmat, -1.0, numeg);
+
+ if (indm == NULL)
+ {
+ ZALLOC(rawcol, nrows, int);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (a = 0; a < nrows; a++)
+ {
+ g = rawcol[a];
+ ccc[a][0] = g;
+ ccc[a][1] = 2 - g;
+ }
+ free (rawcol);
}
- free(rawcol) ;
- }
-
- else {
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
- }
-
- ywt = 1.0 ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
-
- if (k<0) continue ;
- if (k>=numeg) continue ;
+ else
+ {
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
+ }
- cc = ddd[k] ;
- gg = ccc[i] ;
- g = gg[0] ;
- if (g<0) continue ;
- if (g>2) fatalx("fstcolyy bug\n") ;
- if (inbreed == NO) ivvp(cc, cc, gg, 2) ;
- else {
- a = g + gg[1] ;
- if (a==1) g *= 2 ; // X and male
- ++cc[g] ;
+ ywt = 1.0;
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+
+ if (k < 0)
+ continue;
+ if (k >= numeg)
+ continue;
+
+ cc = ddd[k];
+ gg = ccc[i];
+ g = gg[0];
+ if (g < 0)
+ continue;
+ if (g > 2)
+ fatalx ("fstcolyy bug\n");
+ if (inbreed == NO)
+ ivvp (cc, cc, gg, 2);
+ else
+ {
+ a = g + gg[1];
+ if (a == 1)
+ g *= 2; // X and male
+ ++cc[g];
+ }
}
- }
- for (i=0; i<numeg; i++) {
- c1 = ddd[i] ;
- if (intsum(c1, 3) < 2) continue ;
- calchetinbreed(c1, &het, &hetin) ;
+ for (i = 0; i < numeg; i++)
+ {
+ c1 = ddd[i];
+ if (intsum (c1, 3) < 2)
+ continue;
+ calchetinbreed (c1, &het, &hetin);
- estnmat[i] = (het-hetin)*ywt ;
- estdmat[i] = het*ywt ;
- }
+ estnmat[i] = (het - hetin) * ywt;
+ estdmat[i] = het * ywt;
+ }
- free2Dint(&ccc, nrows) ;
- free2Dint(&ddd, numeg) ;
+ free2Dint (&ccc, nrows);
+ free2Dint (&ddd, numeg);
}
-
-void fstcolyy(double *estnmat, double *estdmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg)
+void
+fstcolyy (double *estnmat, double *estdmat, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int numeg)
/**
- NP style n, d estimation for fst No ascertainment
+ NP style n, d estimation for fst No ascertainment
like fstcoly but a matrix of populations so data is only accessed once
-*/
-{
- int *c1, *c2, *cc ;
- int *rawcol ;
- int k, g, i, j, a, b ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
- int **ccc, *gg, **ddd ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ddd = initarray_2Dint(numeg, 3, 0) ;
-
-
-
- vzero(estnmat, numeg*numeg) ;
- vclear(estdmat, -1.0, numeg*numeg) ;
-
- for (a=0; a<numeg; a++) {
- estdmat[a*numeg+a] = 0.0 ;
- }
-
- if (indm == NULL) {
- ZALLOC(rawcol, nrows, int) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (a=0; a<nrows; a++) {
- g = rawcol[a] ;
- ccc[a][0] = g ;
- ccc[a][1] = 2-g ;
+ */
+{
+ int *c1, *c2, *cc;
+ int *rawcol;
+ int k, g, i, j, a, b;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+ int **ccc, *gg, **ddd;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ddd = initarray_2Dint (numeg, 3, 0);
+
+ vzero (estnmat, numeg * numeg);
+ vclear (estdmat, -1.0, numeg * numeg);
+
+ for (a = 0; a < numeg; a++)
+ {
+ estdmat[a * numeg + a] = 0.0;
}
- free(rawcol) ;
- }
- else {
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
- }
-
-
- ywt = 1.0 ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
+ if (indm == NULL)
+ {
+ ZALLOC(rawcol, nrows, int);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (a = 0; a < nrows; a++)
+ {
+ g = rawcol[a];
+ ccc[a][0] = g;
+ ccc[a][1] = 2 - g;
+ }
+ free (rawcol);
+ }
- if (k<0) continue ;
- if (k>=numeg) continue ;
+ else
+ {
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
+ }
- cc = ddd[k] ;
- gg = ccc[i] ;
- g = gg[0] ;
- if (g<0) continue ;
- if (g>2) fatalx("fstcolyy bug\n") ;
- if (inbreed == NO) ivvp(cc, cc, gg, 2) ;
- else {
- a = g + gg[1] ;
- if (a==1) g *= 2 ; // X and male
- ++cc[g] ;
+ ywt = 1.0;
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+
+ if (k < 0)
+ continue;
+ if (k >= numeg)
+ continue;
+
+ cc = ddd[k];
+ gg = ccc[i];
+ g = gg[0];
+ if (g < 0)
+ continue;
+ if (g > 2)
+ fatalx ("fstcolyy bug\n");
+ if (inbreed == NO)
+ ivvp (cc, cc, gg, 2);
+ else
+ {
+ a = g + gg[1];
+ if (a == 1)
+ g *= 2; // X and male
+ ++cc[g];
+ }
}
- }
- for (i=0; i<numeg; i++) {
- if (inbreed != YES) break ;
- for (j=i+1; j<numeg; j++) {
- c1 = ddd[i] ;
- c2 = ddd[j] ;
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- if (intsum(c1, 3) < 2) continue ;
- if (intsum(c2, 3) < 2) continue ;
- calcndinbreed(c1, c2, &en, &ed) ;
-
- if (ed<0.0) fatalx("logic bug\n") ;
- estnmat[i*numeg+j] = estnmat[j*numeg+i] = en*ywt ;
- estdmat[i*numeg+j] = estdmat[j*numeg+i] = ed*ywt ;
+ for (i = 0; i < numeg; i++)
+ {
+ if (inbreed != YES)
+ break;
+ for (j = i + 1; j < numeg; j++)
+ {
+ c1 = ddd[i];
+ c2 = ddd[j];
+ ya = a = c1[0];
+ yb = b = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ if (intsum (c1, 3) < 2)
+ continue;
+ if (intsum (c2, 3) < 2)
+ continue;
+ calcndinbreed (c1, c2, &en, &ed);
+
+ if (ed < 0.0)
+ fatalx ("logic bug\n");
+ estnmat[i * numeg + j] = estnmat[j * numeg + i] = en * ywt;
+ estdmat[i * numeg + j] = estdmat[j * numeg + i] = ed * ywt;
+ }
}
- }
- for (i=0; i<numeg; i++) {
- if (inbreed) break ;
- for (j=i+1; j<numeg; j++) {
- c1 = ddd[i] ;
- c2 = ddd[j] ;
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- zz = yaa+ybb ;
- z = ya + yb ;
- if ((z<1.5) || (zz<1.5)) {
- continue ;
- }
-
-
- z = ya+yb ;
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ; // 2 h1 is heterozygosity
-
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
-
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
-
- if (ed<0.0) fatalx("logic bug\n") ;
- estnmat[i*numeg+j] = estnmat[j*numeg+i] = en*ywt ;
- estdmat[i*numeg+j] = estdmat[j*numeg+i] = ed*ywt ;
+ for (i = 0; i < numeg; i++)
+ {
+ if (inbreed)
+ break;
+ for (j = i + 1; j < numeg; j++)
+ {
+ c1 = ddd[i];
+ c2 = ddd[j];
+ ya = a = c1[0];
+ yb = b = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ zz = yaa + ybb;
+ z = ya + yb;
+ if ((z < 1.5) || (zz < 1.5))
+ {
+ continue;
+ }
+
+ z = ya + yb;
+
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0)); // 2 h1 is heterozygosity
+
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
+
+ ed = en;
+ ed += h1;
+ ed += h2;
+
+ if (ed < 0.0)
+ fatalx ("logic bug\n");
+ estnmat[i * numeg + j] = estnmat[j * numeg + i] = en * ywt;
+ estdmat[i * numeg + j] = estdmat[j * numeg + i] = ed * ywt;
+ }
}
- }
- free2Dint(&ccc, nrows) ;
- free2Dint(&ddd, numeg) ;
+ free2Dint (&ccc, nrows);
+ free2Dint (&ddd, numeg);
}
-
-
-double fstcoly(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+fstcoly (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
/** NP style n, d estimation for fst No ascertainment */
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i, a, b ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
- int **ccc, *gg ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i, a, b;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+ int **ccc, *gg;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+
+ if (indm == NULL)
+ {
+ ZALLOC(rawcol, nrows, int);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (a = 0; a < nrows; a++)
+ {
+ g = rawcol[a];
+ ccc[a][0] = g;
+ ccc[a][1] = 2 - g;
+ }
+ free (rawcol);
+ }
- if (indm == NULL) {
- ZALLOC(rawcol, nrows, int) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (a=0; a<nrows; a++) {
- g = rawcol[a] ;
- ccc[a][0] = g ;
- ccc[a][1] = 2-g ;
+ else
+ {
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
}
- free(rawcol) ;
- }
- else {
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
- }
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ gg = ccc[i];
+ if (ncall == -11)
+ {
+ printf ("zzindx1: %s\n", indm[230]->egroup);
+ printf ("zz2 %d %d ", type1, type2);
+ printf ("%3d %d %3d %3d\n", i, k, gg[0], gg[1]);
+ }
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = gg[0];
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, gg, 2);
+ }
+ ya = a = c1[0];
+ yb = b = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ zz = yaa + ybb;
+ z = ya + yb;
+ if ((z < 1.5) || (zz < 1.5))
+ {
+ *estn = 0.0;
+ *estd = -1.0; /* no data in column */
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- gg = ccc[i] ;
- if (ncall==-11) {
- printf("zzindx1: %s\n", indm[230] -> egroup) ;
- printf("zz2 %d %d ", type1, type2) ;
- printf("%3d %d %3d %3d\n", i, k, gg[0], gg[1]) ;
- }
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = gg[0] ;
- if (g<0) continue ;
- ivvp(cc, cc, gg, 2) ;
- }
+ ywt = ya * yb / (z * (z - 1.0)); // z must be at least 2
+ ywt = 1.0;
- ya = a = c1[0] ;
- yb = b = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- zz = yaa+ybb ;
- z = ya + yb ;
- if ((z<1.5) || (zz<1.5)) {
- *estn = 0.0 ;
- *estd = -1.0 ; /* no data in column */
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
+ z = ya + yb;
- ywt = ya*yb/(z*(z-1.0)) ; // z must be at least 2
- ywt = 1.0 ;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0)); // 2 h1 is heterozygosity
- z = ya+yb ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ; // 2 h1 is heterozygosity
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ ed = en;
+ ed += h1;
+ ed += h2;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ if (ed < 0.0)
+ fatalx ("logic bug\n");
- if (ed<0.0) fatalx("logic bug\n") ;
+ *estn = en * ywt;
+ *estd = ed * ywt;
- *estn = en*ywt ;
- *estd = ed*ywt ;
-
-/**
+ /**
printf("zz %20s %2d %2d ", cupt ->ID, type1, type2) ;
printf("%3d %3d ", c1[0], c1[1]) ;
printf("%3d %3d ", c2[0], c2[1]) ;
printf(" %9.3f %9.3f", *estn, *estd) ;
printnl() ;
-*/
+ */
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
- setplimit(Indiv **indivmarkers, int numindivs,
- char **eglist, int numeg, int plimit)
-{
- int *indnums ;
- int *psize ;
- int i, k, kk ;
- Indiv *indx ;
-
- ZALLOC(indnums, numindivs, int) ;
- ZALLOC(psize, numeg, int) ;
-
+setplimit (Indiv **indivmarkers, int numindivs, char **eglist, int numeg,
+ int plimit)
+{
+ int *indnums;
+ int *psize;
+ int i, k, kk;
+ Indiv *indx;
+
+ ZALLOC(indnums, numindivs, int);
+ ZALLOC(psize, numeg, int);
+
+ idperm (indnums, numindivs);
+ ranperm (indnums, numindivs);
+
+ for (i = 0; i < numindivs; i++)
+ {
+ k = indnums[i];
+ indx = indivmarkers[k];
+ if (indx->ignore)
+ continue;
+ kk = indxindex (eglist, numeg, indx->egroup);
+ if (kk < 0)
+ continue;
+ ++psize[kk];
+ if (psize[kk] > plimit)
+ indx->ignore = YES;
+ }
- idperm(indnums, numindivs) ;
- ranperm(indnums, numindivs) ;
+ free (psize);
+ free (indnums);
- for (i=0; i<numindivs; i++) {
- k = indnums[i] ;
- indx = indivmarkers[k] ;
- if (indx -> ignore) continue ;
- kk = indxindex(eglist, numeg, indx -> egroup) ;
- if (kk<0) continue ;
- ++psize[kk] ;
- if (psize[kk] > plimit) indx -> ignore = YES ;
- }
+}
+double
+dohzg (double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg)
+
+{
+
+ int t1, t2;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int k, g, i, col, j;
+ double ya, yb, y;
+ double *xtop, *xbot;
+ SNP *cupt;
+
+ vzero (top, numeg * numeg);
+ vzero (bot, numeg * numeg);
+
+ ZALLOC(rawcol, nrows, int);
+ ZALLOC(pop0, numeg, int);
+ ZALLOC(pop1, numeg, int);
+ ZALLOC(popall, numeg, int);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ ivzero (popall, numeg);
+ ivzero (pop0, numeg);
+ ivzero (pop1, numeg);
+ cupt = xsnplist[col];
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ pop1[k] += g;
+ pop0[k] += 2 - g;
+ popall[k] += 2; // code needs chamging for X
+ }
+ for (k = 0; k < numeg; k++)
+ {
+ ya = pop0[k];
+ yb = pop1[k];
+ top[k * numeg + k] += 2 * ya * yb;
+ y = ya + yb;
+ bot[k * numeg + k] += y * (y - 1.0);
+ for (j = k + 1; j < numeg; j++)
+ {
+ ya = pop0[j];
+ yb = pop1[k];
+ y = ya + yb;
+ top[k * numeg + j] += ya * yb;
+ ya = pop1[j];
+ yb = pop0[k];
+ top[j * numeg + k] = top[k * numeg + j] += ya * yb;
+
+ ya = popall[k];
+ yb = popall[j];
+ bot[k * numeg + j] += ya * yb;
+
+ top[j * numeg + k] = top[k * numeg + j];
+ bot[j * numeg + k] = bot[k * numeg + j];
+ }
+ }
+ }
+ ZALLOC(xtop, numeg*numeg, double);
+ ZALLOC(xbot, numeg*numeg, double);
+ copyarr (bot, xbot, numeg * numeg);
+ y = bal1 (xbot, numeg * numeg);
+ vst (xtop, top, 1.0 / y, numeg * numeg);
+ free (xtop);
+ free (xbot);
- free(psize) ;
- free(indnums) ;
+ free (rawcol);
+ free (pop0);
+ free (pop1);
+ free (popall);
}
-double dohzg(double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg)
-
+void
+setblocks (int *block, int *bsize, int *nblock, SNP **snpm, int numsnps,
+ double blocklen)
+// block, bsize are first element and block length
+// must have been allocated if not NULL
{
+ int n = 0, i;
+ int chrom, xsize, lchrom, olds;
+ double fpos, dis, gpos;
+ SNP *cupt;
+
+ lchrom = -1;
+ xsize = 0;
+
+ fpos = -1.0e20;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ cupt->tagnumber = -1;
+ if (cupt->ignore)
+ continue;
+ if (cupt->isfake)
+ continue;
+ chrom = cupt->chrom;
+ gpos = cupt->genpos;
+ dis = gpos - fpos;
+ if ((chrom != lchrom) || (dis >= blocklen))
+ {
+ if (xsize > 0)
+ {
+ if (block != NULL)
+ block[n] = olds;
+ if (bsize != NULL)
+ bsize[n] = xsize;
+ ++n;
+ }
+ lchrom = chrom;
+ fpos = gpos;
+ olds = i;
+ xsize = 0;
+ }
+ cupt->tagnumber = n;
+ ++xsize;
+ }
+ if (xsize > 0)
+ {
+ if (block != NULL)
+ block[n] = olds;
+ if (bsize != NULL)
+ bsize[n] = xsize;
+ ++n;
+ }
+ *nblock = n;
+ return;
+}
- int t1, t2 ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int k, g, i, col, j ;
- double ya, yb, y ;
- double *xtop, *xbot ;
- SNP *cupt ;
-
-
- vzero(top, numeg*numeg) ;
- vzero(bot, numeg*numeg) ;
+int
+numblocks (SNP **snpm, int numsnps, double blocklen)
+{
+ int n;
- ZALLOC(rawcol, nrows, int) ;
- ZALLOC(pop0, numeg, int) ;
- ZALLOC(pop1, numeg, int) ;
- ZALLOC(popall, numeg, int) ;
+ setblocks (NULL, NULL, &n, snpm, numsnps, blocklen);
+ return n;
+}
- for (col=0; col<ncols; ++col) {
- ivzero(popall, numeg) ;
- ivzero(pop0, numeg) ;
- ivzero(pop1, numeg) ;
- cupt = xsnplist[col] ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- g = rawcol[i] ;
- if (g<0) continue ;
- pop1[k] += g ;
- pop0[k] += 2-g ;
- popall[k] += 2 ; // code needs chamging for X
+void
+corrwjack (double *xrho, double *xsig, double *z1, double *z2, int ncols,
+ int *bcols, int nblocks)
+{
+ double *gdot, *dot, *wdot;
+ double **bdot;
+ double *djack, *wjack;
+ double rho, jest, jsig;
+ double y1, y2;
+ int bnum, i, k;
+
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ ZALLOC(gdot, 6, double);
+ ZALLOC(wdot, 6, double);
+
+ bdot = initarray_2Ddouble (nblocks, 6, 0.0);
+
+ for (i = 0; i < ncols; i++)
+ {
+ bnum = bcols[i];
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ dot = bdot[bnum];
+ y1 = z1[i];
+ y2 = z2[i];
+ dot[0] += y1 * y1;
+ dot[1] += y2 * y2;
+ dot[2] += y1 * y2;
+ dot[3] += y1;
+ dot[4] += y2;
+ dot[5] += 1.0;
}
- for (k=0; k<numeg; k++) {
- ya = pop0[k] ;
- yb = pop1[k] ;
- top[k*numeg+k] += 2*ya*yb ;
- y = ya + yb ;
- bot[k*numeg+k] += y*(y-1.0) ;
- for (j=k+1; j<numeg; j++) {
- ya = pop0[j] ;
- yb = pop1[k] ;
- y = ya + yb ;
- top[k*numeg+j] += ya*yb ;
- ya = pop1[j] ;
- yb = pop0[k] ;
- top[j*numeg+k] = top[k*numeg+j] += ya*yb ;
-
- ya = popall[k] ;
- yb = popall[j] ;
- bot[k*numeg+j] += ya*yb ;
-
- top[j*numeg+k] = top[k*numeg+j] ;
- bot[j*numeg+k] = bot[k*numeg+j] ;
- }
+ for (k = 0; k < nblocks; k++)
+ {
+ dot = bdot[k];
+ vvp (gdot, gdot, dot, 6);
}
- }
- ZALLOC(xtop, numeg*numeg, double) ;
- ZALLOC(xbot, numeg*numeg, double) ;
- copyarr(bot, xbot, numeg*numeg) ;
- y = bal1(xbot, numeg*numeg) ;
- vst(xtop, top, 1.0/y, numeg*numeg) ;
-
- free(xtop) ;
- free(xbot) ;
-
+ rho = crho (gdot);
+// printmatw(gdot, 1, 6, 6) ;
+ for (k = 0; k < nblocks; k++)
+ {
+ dot = bdot[k];
+ vvm (wdot, gdot, dot, 6);
+ djack[k] = crho (wdot);
+ }
+ wjackest (&jest, &jsig, rho, djack, wjack, nblocks);
+ *xrho = jest;
+ *xsig = jsig;
- free(rawcol) ;
- free(pop0) ;
- free(pop1) ;
- free(popall) ;
+ free (djack);
+ free (wjack);
+ free (gdot);
+ free (wdot);
+ free2D (&bdot, nblocks);
}
-
-void setblocks(int *block, int *bsize, int *nblock, SNP **snpm, int numsnps, double blocklen)
-// block, bsize are first element and block length
-// must have been allocated if not NULL
-{
- int n = 0, i ;
- int chrom, xsize, lchrom, olds ;
- double fpos, dis, gpos ;
- SNP *cupt ;
-
-
- lchrom = -1 ; xsize = 0 ;
-
- fpos = -1.0e20 ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- cupt -> tagnumber = -1 ;
- if (cupt -> ignore) continue ;
- if (cupt -> isfake) continue ;
- chrom = cupt -> chrom ;
- gpos = cupt -> genpos ;
- dis = gpos - fpos ;
- if ((chrom != lchrom) || (dis>=blocklen)) {
- if (xsize>0) {
- if (block != NULL) block[n] = olds ;
- if (bsize != NULL) bsize[n] = xsize ;
- ++n ;
- }
- lchrom = chrom ;
- fpos = gpos ;
- olds = i ;
- xsize = 0 ;
- }
- cupt -> tagnumber = n ;
- ++xsize ;
- }
- if (xsize>0) {
- if (block != NULL) block[n] = olds ;
- if (bsize != NULL) bsize[n] = xsize ;
- ++n ;
+double
+crho (double *stats)
+{
+ /* correlation from 6 sufficient statistics */
+ double m1, m2, top, bot, b1, b2, rr;
+ double s1, s2, s11, s22, s12, yn;
+ static int ncall = 0;
+
+ ++ncall;
+ s11 = stats[0];
+ s22 = stats[1];
+ s12 = stats[2];
+ s1 = stats[3];
+ s2 = stats[4];
+ yn = stats[5];
+
+ m1 = s1 / yn;
+ m2 = s2 / yn;
+ top = s12 - yn * m1 * m2;
+ b1 = s11 - yn * m1 * m1;
+ b2 = s22 - yn * m2 * m2;
+
+ if (ncall < -1)
+ {
+ printf ("%9.3f\n", m1);
+ printf ("%9.3f\n", m2);
+ printf ("%9.3f\n", top);
+ printf ("%9.3f\n", b1);
+ printf ("%9.3f\n", b2);
}
- *nblock = n ;
- return ;
-}
+ rr = top / sqrt (b1 * b2);
+
+ return rr;
+}
-int numblocks(SNP **snpm, int numsnps, double blocklen)
+void
+setbcols (SNP **xsnplist, int ncols, int *bcols)
{
- int n ;
+ int col, bnum;
+ SNP *cupt;
- setblocks(NULL, NULL, &n, snpm, numsnps, blocklen) ;
- return n ;
+ ivclear (bcols, -1, ncols);
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ bnum = cupt->tagnumber;
+ bcols[col] = bnum;
+ }
}
-void corrwjack(double *xrho, double *xsig, double *z1, double *z2, int ncols, int *bcols, int nblocks)
-{
- double *gdot, *dot, *wdot ;
- double **bdot ;
- double *djack, *wjack ;
- double rho, jest, jsig ;
- double y1, y2 ;
- int bnum, i, k ;
+double
+doadmlin (double *jest, double *jsig, double *zlin, double *var, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, double scale, Indiv **indm)
+{
+
+ int t1, t2, kret;
+ int a, b, c;
+ int ng3, ng2;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int k, g, i, col, j, d;
+ double ya, yb, y, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot, wt;
+ double *w1, *w2, *w3;
+ double ytop, ybot;
+ double y1, y2, yscal;
+ double xest, xsig, ynominal;
+ int bnum;
+
+ double *f3, *f3sig;
+ double *estmat, *zl, *rhs, errest;
+ double *vmean, **vjmean;
+
+ ng2 = numeg * numeg;
+ ng3 = numeg * numeg * numeg;
+
+ ZALLOC(f3, ng3, double);
+ ZALLOC(f3sig, ng3, double);
+ ZALLOC(w1, ng3+2, double);
+ ZALLOC(w2, ng3+2, double);
+ ZALLOC(estmat, ng3, double);
+ ZALLOC(w3, ng3, double);
+ ZALLOC(gtop, ng3, double);
+ ZALLOC(gbot, ng3, double);
+ ZALLOC(wtop, ng3, double);
+ ZALLOC(wbot, ng3, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ btop = initarray_2Ddouble (nblocks, ng3, 0.0);
+ bbot = initarray_2Ddouble (nblocks, ng3, 0.0);
+
+ d = numeg - 1;
+ vjmean = initarray_2Ddouble (nblocks, numeg, 0.0);
+ ZALLOC(vmean, numeg, double);
+
+ zl = w1;
+ rhs = w2; // overloading
+
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ if (cupt->ignore)
+ continue;
+ wt = cupt->weight;
+ if (wt <= 0.0)
+ continue;
+ bnum = cupt->tagnumber;
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+
+ kret = f3yyx (estmat, cupt, xindex, xtypes, nrows, numeg, indm);
+ if (kret < 0)
+ continue;
+ vst (estmat, estmat, wt * scale, ng3);
+ vvp (top, top, estmat, ng3);
+ vsp (bot, bot, 1.0, ng3);
+ }
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- ZALLOC(gdot, 6, double) ;
- ZALLOC(wdot, 6, double) ;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, ng3);
+ vvp (gbot, gbot, bot, ng3);
+ }
- bdot = initarray_2Ddouble(nblocks, 6, 0.0) ;
+ vsp (w2, gbot, 1.0e-10, ng3);
+ vvd (f3, gtop, w2, ng3);
+ vzero (zl, numeg);
+ estmix (zl + 1, f3, numeg);
+ copyarr (zl + 1, vmean, d);
- for (i=0; i<ncols; i++) {
- bnum = bcols[i] ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- dot = bdot[bnum] ;
- y1 = z1[i] ;
- y2 = z2[i] ;
- dot[0] += y1*y1 ;
- dot[1] += y2*y2 ;
- dot[2] += y1*y2 ;
- dot[3] += y1 ;
- dot[4] += y2 ;
- dot[5] += 1.0 ;
- }
- for (k=0; k<nblocks; k++) {
- dot = bdot[k] ;
- vvp(gdot, gdot, dot, 6) ;
- }
- rho = crho(gdot) ;
-// printmatw(gdot, 1, 6, 6) ;
- for (k=0; k<nblocks; k++) {
- dot = bdot[k] ;
- vvm(wdot, gdot, dot, 6) ;
- djack[k] = crho(wdot) ;
- }
- wjackest(&jest, &jsig, rho, djack, wjack, nblocks) ;
- *xrho = jest ;
- *xsig = jsig ;
-
- free(djack) ;
- free(wjack) ;
- free(gdot) ;
- free(wdot) ;
- free2D(&bdot, nblocks) ;
-
-
-}
-double crho(double *stats)
-{
-/* correlation from 6 sufficient statistics */
- double m1, m2, top, bot, b1, b2, rr ;
- double s1, s2, s11, s22, s12, yn ;
- static int ncall = 0 ;
-
- ++ncall ;
- s11 = stats[0] ;
- s22 = stats[1] ;
- s12 = stats[2] ;
- s1 = stats[3] ;
- s2 = stats[4] ;
- yn = stats[5] ;
-
- m1 = s1/yn ;
- m2 = s2/yn ;
- top = s12 - yn*m1*m2 ;
- b1 = s11 - yn*m1*m1 ;
- b2 = s22 - yn*m2*m2 ;
-
- if (ncall < -1) {
- printf("%9.3f\n", m1) ;
- printf("%9.3f\n", m2) ;
- printf("%9.3f\n", top) ;
- printf("%9.3f\n", b1) ;
- printf("%9.3f\n", b2) ;
- }
- rr = top/sqrt(b1*b2) ;
-
- return rr ;
-}
-
-void setbcols(SNP **xsnplist, int ncols, int *bcols)
-{
- int col, bnum ;
- SNP *cupt ;
-
- ivclear(bcols, -1, ncols) ;
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- bnum = cupt -> tagnumber ;
- bcols[col] = bnum ;
- }
-}
+ ynominal = y = estmix (zlin, f3, numeg);
-double
-doadmlin(double *jest, double *jsig, double *zlin, double *var, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, Indiv **indm)
-{
-
- int t1, t2, kret ;
- int a, b, c ;
- int ng3, ng2 ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int k, g, i, col, j, d ;
- double ya, yb, y, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot, wt ;
- double *w1, *w2, *w3 ;
- double ytop, ybot ;
- double y1, y2, yscal ;
- double xest, xsig, ynominal ;
- int bnum ;
-
- double *f3, *f3sig ;
- double *estmat, *zl, *rhs, errest ;
- double *vmean, **vjmean ;
-
- ng2 = numeg*numeg ;
- ng3 = numeg*numeg*numeg ;
-
- ZALLOC(f3, ng3, double) ;
- ZALLOC(f3sig, ng3, double) ;
- ZALLOC(w1, ng3+2, double) ;
- ZALLOC(w2, ng3+2, double) ;
- ZALLOC(estmat, ng3, double) ;
- ZALLOC(w3, ng3, double) ;
- ZALLOC(gtop, ng3, double) ;
- ZALLOC(gbot, ng3, double) ;
- ZALLOC(wtop, ng3, double) ;
- ZALLOC(wbot, ng3, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- btop = initarray_2Ddouble(nblocks, ng3, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, ng3, 0.0) ;
-
- d = numeg - 1 ;
- vjmean = initarray_2Ddouble(nblocks, numeg, 0.0) ;
- ZALLOC(vmean, numeg, double) ;
-
- zl = w1 ;
- rhs = w2 ; // overloading
-
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- if (cupt -> ignore) continue ;
- wt = cupt -> weight ;
- if (wt <= 0.0) continue ;
- bnum = cupt -> tagnumber ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
-
- kret = f3yyx(estmat, cupt, xindex, xtypes, nrows, numeg, indm) ;
- if (kret < 0) continue ;
- vst(estmat, estmat, wt*scale, ng3) ;
- vvp(top, top, estmat, ng3) ;
- vsp(bot, bot, 1.0, ng3) ;
+ if (verbose)
+ {
- }
+ for (i = 0; i < numeg; ++i)
+ {
+ printf ("f3: base number %d:\n", i);
+ printmatw (f3 + i * numeg * numeg, numeg, numeg, numeg);
+ }
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, ng3) ;
- vvp(gbot, gbot, bot, ng3) ;
+ printf ("nominal error: %12.6f\n", y);
}
- vsp(w2, gbot, 1.0e-10, ng3) ;
- vvd(f3, gtop, w2, ng3) ;
+ ytop = ybot = errest = 0.0;
+
+ vvd (wtop, gtop, gbot, ng3); // delete-block estimate
+
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, ng3);
+ vvm (wbot, gbot, bot, ng3);
+ vsp (wbot, wbot, 1.0e-10, ng3);
+ vvd (wtop, wtop, wbot, ng3); // delete-block estimate
+ vzero (zl, numeg);
+ djack[k] = estmix (zl + 1, wtop, numeg);
+ copyarr (zl + 1, vjmean[k], d);
+/// printf("yyy: %4d %9.3f %12.6f\n", k, wjack[k], djack[k]) ;
+ mulmat (rhs, top, zl, numeg, numeg, 1);
+ y = vdot (zl, rhs, numeg);
+ ytop += y;
+ ybot += bot[0];
+ if (verbose)
+ printf ("www: %4d %9.3f %12.6f\n", k, wjack[k], y);
+ }
- vzero(zl, numeg) ;
- estmix(zl+1, f3, numeg) ;
- copyarr(zl+1, vmean, d) ;
+ errest = ytop / ybot;
+// jackknife estimate of standard error for variance
+ wjackest (&xest, &xsig, ynominal, djack, wjack, nblocks);
+ wjackvest (vmean, var, d, zlin, vjmean, wjack, nblocks);
+ *jest = xest;
+ *jsig = xsig;
+ free (w1);
+ free (w2);
+ free (w3);
+ free (estmat);
- ynominal = y = estmix(zlin, f3, numeg) ;
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (djack);
+ free (wjack);
+ free (f3);
+ free (f3sig);
- if (verbose) {
+ free (vmean);
- for (i=0; i<numeg; ++i) {
- printf("f3: base number %d:\n", i) ;
- printmatw(f3+i*numeg*numeg, numeg, numeg, numeg) ;
- }
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
+ free2D (&vjmean, nblocks);
- printf("nominal error: %12.6f\n", y) ;
- }
+ return errest;
+}
+void
+dof3 (double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
+{
+
+ int t1, t2;
+ int a, b, c;
+ int ng3;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int k, g, i, col, j;
+ double ya, yb, y, jest, jsig, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot, wt;
+ double *w1, *w2, *w3;
+ double ytop, ybot;
+ double y1, y2, yscal;
+ int bnum;
+ double *estmat;
+
+ ng3 = numeg * numeg * numeg;
+ ZALLOC(w1, ng3, double);
+ ZALLOC(w2, ng3, double);
+ ZALLOC(estmat, ng3, double);
+ ZALLOC(w3, ng3, double);
+ ZALLOC(gtop, ng3, double);
+ ZALLOC(gbot, ng3, double);
+ ZALLOC(wtop, ng3, double);
+ ZALLOC(wbot, ng3, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ btop = initarray_2Ddouble (nblocks, ng3, 0.0);
+ bbot = initarray_2Ddouble (nblocks, ng3, 0.0);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ if (cupt->ignore)
+ continue;
+ wt = cupt->weight;
+ if (wt <= 0.0)
+ continue;
+ bnum = cupt->tagnumber;
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+
+ f3yy (estmat, cupt, xindex, xtypes, nrows, numeg);
+
+ if (mode != 2)
+ {
+ vst (estmat, estmat, wt, ng3);
+ vvp (top, top, estmat, ng3);
+ vsp (bot, bot, 1.0, ng3);
+ }
+ else
+ {
+ vvp (top, top, estmat, ng3);
+ vsp (bot, bot, 1.0 / wt, ng3);
+ }
+ }
- ytop = ybot = errest = 0.0 ;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, ng3);
+ vvp (gbot, gbot, bot, ng3);
+ }
- vvd(wtop, gtop, gbot, ng3) ; // delete-block estimate
+ vsp (w2, gbot, 1.0e-10, ng3);
+ vvd (f3, gtop, w2, ng3);
+
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, ng3);
+ vvm (wbot, gbot, bot, ng3);
+ vsp (wbot, wbot, 1.0e-10, ng3);
+ vvd (top, wtop, wbot, ng3); // delete-block estimate
+ }
+ vsp (gbot, gbot, 1.0e-10, ng3);
+ vvd (gtop, gtop, gbot, ng3);
+
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = 0; b < numeg; b++)
+ {
+ for (c = 0; c < numeg; c++)
+ {
+ if (a == b)
+ continue;
+ if (a == c)
+ continue;
+ if (c < b)
+ continue;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ djack[k] = dump3 (top, a, b, c, numeg);
+ }
+
+ mean = dump3 (gtop, a, b, c, numeg);
+ wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
+ bump3 (f3sig, a, b, c, numeg, jsig);
+ bump3 (f3sig, a, c, b, numeg, jsig);
+ }
+ }
+ }
+ vst (f3, f3, scale, ng3);
+ vst (f3sig, f3sig, scale, ng3);
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, ng3) ;
- vvm(wbot, gbot, bot, ng3) ;
- vsp(wbot, wbot, 1.0e-10, ng3) ;
- vvd(wtop, wtop, wbot, ng3) ; // delete-block estimate
- vzero(zl, numeg) ;
- djack[k] = estmix(zl+1, wtop, numeg) ;
- copyarr(zl+1, vjmean[k], d) ;
-/// printf("yyy: %4d %9.3f %12.6f\n", k, wjack[k], djack[k]) ;
- mulmat(rhs, top, zl, numeg, numeg, 1) ;
- y = vdot(zl, rhs, numeg) ;
- ytop += y ;
- ybot += bot[0] ;
- if (verbose)
- printf("www: %4d %9.3f %12.6f\n", k, wjack[k], y) ;
+ free (w1);
+ free (w2);
+ free (w3);
+ free (estmat);
+
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (djack);
+ free (wjack);
+
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
+
+}
+void
+bump2 (double *x, int a, int b, int n, double val)
+{
+ int k;
+ k = a;
+ k *= n;
+ k += b;
+ x[k] += val;
+}
+void
+bump3 (double *x, int a, int b, int c, int n, double val)
+{
+ int k;
+ k = a;
+ k *= n;
+ k += b;
+ k *= n;
+ k += c;
+ x[k] += val;
+}
+double
+dump2 (double *x, int a, int b, int n)
+{
+ int k;
+ double val;
+ k = a;
+ k *= n;
+ k += b;
+ val = x[k];
+ return val;
+}
+double
+dump3 (double *x, int a, int b, int c, int n)
+{
+ int k;
+ double val;
+ k = a;
+ k *= n;
+ k += b;
+ k *= n;
+ k += c;
+ val = x[k];
+ return val;
+}
+void
+dof4 (double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
+{
+
+ int t1, t2;
+ int a, b, c, d;
+ int ng4;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int k, g, i, col, j;
+ double ya, yb, y, jest, jsig, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot, wt;
+ double *w1, *w2, *w3;
+ double ytop, ybot;
+ double y1, y2, yscal;
+ int bnum;
+ int nloop = 0;
+
+ ng4 = numeg * numeg * numeg * numeg;
+ ZALLOC(w1, ng4, double);
+ ZALLOC(w2, ng4, double);
+ ZALLOC(w3, ng4, double);
+ ZALLOC(gtop, ng4, double);
+ ZALLOC(gbot, ng4, double);
+ ZALLOC(wtop, ng4, double);
+ ZALLOC(wbot, ng4, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ btop = initarray_2Ddouble (nblocks, ng4, 0.0);
+ bbot = initarray_2Ddouble (nblocks, ng4, 0.0);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ if (cupt->ignore)
+ continue;
+ wt = cupt->weight;
+ if (wt <= 0.0)
+ continue;
+ bnum = cupt->tagnumber;
+ if (bnum < 0)
+ continue;
+ if (bnum >= nblocks)
+ fatalx ("logic bug\n");
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = 0; b < numeg; b++)
+ {
+ for (c = 0; c < numeg; c++)
+ {
+ for (d = 0; d < numeg; d++)
+ {
+
+ if (a == b)
+ continue;
+ if (a == c)
+ continue;
+ if (a == d)
+ continue;
+ if (b == c)
+ continue;
+ if (b == d)
+ continue;
+ if (c == d)
+ continue;
+
+ if (b < a)
+ continue;
+ if (c < a)
+ continue;
+ if (d < a)
+ continue;
+ if (d < c)
+ continue;
+
+ f4y (&ytop, cupt, xindex, xtypes, nrows, a, b, c, d);
+ ++nloop;
+ // if (nloop<100) printf("zz1 %d %d %d %d %9.3f\n", a, b, c, d, ytop) ;
+ if (isnan(ytop))
+ fatalx ("zznan\n");
+
+ if (mode != 2)
+ {
+ bump4x (top, a, b, c, d, numeg, wt * ytop);
+ bump4x (top, b, a, c, d, numeg, -wt * ytop);
+ bump4x (bot, a, b, c, d, numeg, 1.0);
+ bump4x (bot, b, a, c, d, numeg, 1.0);
+ }
+ else
+ {
+ bump4x (top, a, b, c, d, numeg, ytop);
+ bump4x (top, b, a, c, d, numeg, -ytop);
+ bump4x (bot, a, b, c, d, numeg, 1.0 / wt);
+ bump4x (bot, b, a, c, d, numeg, 1.0 / wt);
+ }
+
+ }
+ }
+ }
+ }
}
- errest = ytop/ybot ;
-// jackknife estimate of standard error for variance
- wjackest(&xest, &xsig, ynominal, djack, wjack, nblocks) ;
- wjackvest(vmean, var, d, zlin, vjmean, wjack, nblocks) ;
- *jest = xest ;
- *jsig = xsig ;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, ng4);
+ vvp (gbot, gbot, bot, ng4);
+ }
- free(w1) ;
- free(w2) ;
- free(w3) ;
- free(estmat) ;
+ vsp (w2, gbot, 1.0e-10, ng4);
+ vvd (f4, gtop, w2, ng4);
+
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, ng4);
+ vvm (wbot, gbot, bot, ng4);
+ vsp (wbot, wbot, 1.0e-10, ng4);
+ vvd (top, wtop, wbot, ng4); // delete-block estimate
+ }
+ vsp (gbot, gbot, 1.0e-10, ng4);
+ vvd (gtop, gtop, gbot, ng4);
+
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = 0; b < numeg; b++)
+ {
+ for (c = 0; c < numeg; c++)
+ {
+ for (d = 0; d < numeg; d++)
+ {
+ if (a == b)
+ continue;
+ if (a == c)
+ continue;
+ if (a == d)
+ continue;
+ if (b == c)
+ continue;
+ if (b == d)
+ continue;
+ if (c == d)
+ continue;
+
+ if (b < a)
+ continue;
+ if (c < a)
+ continue;
+ if (d < a)
+ continue;
+ if (d < c)
+ continue;
+
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ djack[k] = dump4 (top, a, b, c, d, numeg);
+ }
+
+ mean = dump4 (gtop, a, b, c, d, numeg);
+ wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
+ bump4x (f4sig, a, b, c, d, numeg, jsig);
+ bump4x (f4sig, b, a, c, d, numeg, jsig);
+ }
+ }
+ }
+ }
+ vst (f4, f4, scale, ng4);
+ vst (f4sig, f4sig, scale, ng4);
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(djack) ;
- free(wjack) ;
- free(f3) ;
- free(f3sig) ;
+ free (w1);
+ free (w2);
+ free (w3);
- free(vmean) ;
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (djack);
+ free (wjack);
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
- free2D(&vjmean, nblocks);
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
- return errest ;
+}
+void
+bump4x (double *x, int a, int b, int c, int d, int n, double val)
+{
+ bump4 (x, a, b, c, d, n, val);
+ bump4 (x, b, a, d, c, n, val);
+ bump4 (x, c, d, a, b, n, val);
+ bump4 (x, d, c, b, a, n, val);
}
+void
+bump4 (double *x, int a, int b, int c, int d, int n, double val)
+{
+ int k;
+ k = a;
+ k *= n;
+ k += b;
+ k *= n;
+ k += c;
+ k *= n;
+ k += d;
+ x[k] += val;
+}
+void
+set4x (double *x, int a, int b, int c, int d, int n, double val)
+{
+ set4 (x, a, b, c, d, n, val);
+ set4 (x, b, a, d, c, n, val);
+ set4 (x, c, d, a, b, n, val);
+ set4 (x, d, c, b, a, n, val);
+}
void
-dof3(double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
-{
-
- int t1, t2 ;
- int a, b, c ;
- int ng3 ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int k, g, i, col, j ;
- double ya, yb, y, jest, jsig, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot, wt ;
- double *w1, *w2, *w3 ;
- double ytop, ybot ;
- double y1, y2, yscal ;
- int bnum ;
- double *estmat ;
-
- ng3 = numeg*numeg*numeg ;
- ZALLOC(w1, ng3, double) ;
- ZALLOC(w2, ng3, double) ;
- ZALLOC(estmat, ng3, double) ;
- ZALLOC(w3, ng3, double) ;
- ZALLOC(gtop, ng3, double) ;
- ZALLOC(gbot, ng3, double) ;
- ZALLOC(wtop, ng3, double) ;
- ZALLOC(wbot, ng3, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- btop = initarray_2Ddouble(nblocks, ng3, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, ng3, 0.0) ;
-
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- if (cupt -> ignore) continue ;
- wt = cupt -> weight ;
- if (wt <= 0.0) continue ;
- bnum = cupt -> tagnumber ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
-
- f3yy(estmat, cupt, xindex, xtypes, nrows, numeg) ;
-
- if (mode != 2) {
- vst(estmat, estmat, wt, ng3) ;
- vvp(top, top, estmat, ng3) ;
- vsp(bot, bot, 1.0, ng3) ;
- }
- else {
- vvp(top, top, estmat, ng3) ;
- vsp(bot, bot, 1.0/wt, ng3) ;
- }
- }
+set4 (double *x, int a, int b, int c, int d, int n, double val)
+{
+ int k;
+ k = a;
+ k *= n;
+ k += b;
+ k *= n;
+ k += c;
+ k *= n;
+ k += d;
+ x[k] = val;
+}
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, ng3) ;
- vvp(gbot, gbot, bot, ng3) ;
- }
-
- vsp(w2, gbot, 1.0e-10, ng3) ;
- vvd(f3, gtop, w2, ng3) ;
-
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, ng3) ;
- vvm(wbot, gbot, bot, ng3) ;
- vsp(wbot, wbot, 1.0e-10, ng3) ;
- vvd(top, wtop, wbot, ng3) ; // delete-block estimate
- }
- vsp(gbot, gbot, 1.0e-10, ng3) ;
- vvd(gtop, gtop, gbot, ng3) ;
-
-
- for (a=0; a<numeg ; a++) {
- for (b=0; b<numeg ; b++) {
- for (c=0 ; c<numeg ; c++) {
- if (a==b) continue ;
- if (a==c) continue ;
- if (c<b) continue ;
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- djack[k] = dump3(top, a, b, c, numeg) ;
- }
-
- mean = dump3(gtop, a, b, c, numeg) ;
- wjackest(&jest, &jsig, mean, djack, wjack, nblocks) ;
- bump3(f3sig, a, b, c, numeg, jsig) ;
- bump3(f3sig, a, c, b, numeg, jsig) ;
- }
- }
- }
- vst(f3, f3, scale, ng3) ;
- vst(f3sig, f3sig, scale, ng3) ;
-
- free(w1) ;
- free(w2) ;
- free(w3) ;
- free(estmat) ;
-
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(djack) ;
- free(wjack) ;
-
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
-
-}
-void bump2(double *x, int a, int b, int n, double val)
-{
- int k ;
- k = a ;
- k *= n ;
- k += b ;
- x[k] += val ;
-}
-void bump3(double *x, int a, int b, int c, int n, double val)
-{
- int k ;
- k = a ;
- k *= n ;
- k += b ;
- k *= n ;
- k += c ;
- x[k] += val ;
-}
-double dump2(double *x, int a, int b, int n)
-{
- int k ;
- double val ;
- k = a ;
- k *= n ;
- k += b ;
- val = x[k] ;
- return val ;
-}
-double dump3(double *x, int a, int b, int c, int n)
-{
- int k ;
- double val ;
- k = a ;
- k *= n ;
- k += b ;
- k *= n ;
- k += c ;
- val = x[k] ;
- return val ;
+double
+dump4 (double *x, int a, int b, int c, int d, int n)
+{
+ int k;
+ double val;
+ k = a;
+ k *= n;
+ k += b;
+ k *= n;
+ k += c;
+ k *= n;
+ k += d;
+ val = x[k];
+ return val;
}
-void
-dof4(double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
-{
-
- int t1, t2 ;
- int a, b, c, d ;
- int ng4 ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int k, g, i, col, j ;
- double ya, yb, y, jest, jsig, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot, wt ;
- double *w1, *w2, *w3 ;
- double ytop, ybot ;
- double y1, y2, yscal ;
- int bnum ;
- int nloop = 0 ;
-
- ng4 = numeg*numeg*numeg*numeg ;
- ZALLOC(w1, ng4, double) ;
- ZALLOC(w2, ng4, double) ;
- ZALLOC(w3, ng4, double) ;
- ZALLOC(gtop, ng4, double) ;
- ZALLOC(gbot, ng4, double) ;
- ZALLOC(wtop, ng4, double) ;
- ZALLOC(wbot, ng4, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- btop = initarray_2Ddouble(nblocks, ng4, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, ng4, 0.0) ;
-
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- if (cupt -> ignore) continue ;
- wt = cupt -> weight ;
- if (wt <= 0.0) continue ;
- bnum = cupt -> tagnumber ;
- if (bnum<0) continue ;
- if (bnum>=nblocks) fatalx("logic bug\n") ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
-
- for (a=0; a<numeg ; a++) {
- for (b=0; b<numeg ; b++) {
- for (c=0 ; c<numeg ; c++) {
- for (d=0 ; d<numeg ; d++) {
-
- if (a==b) continue ;
- if (a==c) continue ;
- if (a==d) continue ;
- if (b==c) continue ;
- if (b==d) continue ;
- if (c==d) continue ;
-
- if (b<a) continue ;
- if (c<a) continue ;
- if (d<a) continue ;
- if (d<c) continue ;
-
- f4y(&ytop, cupt, xindex, xtypes, nrows, a, b, c, d) ;
- ++nloop ;
- // if (nloop<100) printf("zz1 %d %d %d %d %9.3f\n", a, b, c, d, ytop) ;
- if (isnan(ytop)) fatalx("zznan\n") ;
-
- if (mode != 2) {
- bump4x(top, a, b, c, d, numeg, wt*ytop) ;
- bump4x(top, b, a, c, d, numeg, -wt*ytop) ;
- bump4x(bot, a, b, c, d, numeg, 1.0) ;
- bump4x(bot, b, a, c, d, numeg, 1.0) ;
- }
- else {
- bump4x(top, a, b, c, d, numeg, ytop) ;
- bump4x(top, b, a, c, d, numeg, -ytop) ;
- bump4x(bot, a, b, c, d, numeg, 1.0/wt) ;
- bump4x(bot, b, a, c, d, numeg, 1.0/wt) ;
- }
-
- }
- }
+
+double
+doinbreed (double *inb, double *inbest, double *inbsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, Indiv **indivmarkers)
+
+{
+
+ int t1, t2;
+ int a, b;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int t, k, g, i, col, j;
+ double ya, yb, y, jest, jsig, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot, wt;
+ double *w1, *w2, *w3;
+ double ytop, ybot;
+ double y1, y2, yscal;
+ int bnum;
+ int nloop = 0, fstdnum = 0;
+ double *ztop, *zbot, qtop, qbot;
+ char **eglist;
+
+ indm = indivmarkers;
+
+ ZALLOC(eglist, numeg, char *);
+ for (k = 0; k < nrows; ++k)
+ {
+ if (indm == NULL)
+ break;
+ j = xtypes[k];
+ if (j < 0)
+ continue;
+ if (j >= numeg)
+ continue;
+ t = xindex[k];
+ eglist[j] = indm[t]->egroup;
}
- }
- }
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, ng4) ;
- vvp(gbot, gbot, bot, ng4) ;
- }
-
- vsp(w2, gbot, 1.0e-10, ng4) ;
- vvd(f4, gtop, w2, ng4) ;
-
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, ng4) ;
- vvm(wbot, gbot, bot, ng4) ;
- vsp(wbot, wbot, 1.0e-10, ng4) ;
- vvd(top, wtop, wbot, ng4) ; // delete-block estimate
- }
- vsp(gbot, gbot, 1.0e-10, ng4) ;
- vvd(gtop, gtop, gbot, ng4) ;
-
-
- for (a=0; a<numeg ; a++) {
- for (b=0; b<numeg ; b++) {
- for (c=0 ; c<numeg ; c++) {
- for (d=0 ; d<numeg ; d++) {
- if (a==b) continue ;
- if (a==c) continue ;
- if (a==d) continue ;
- if (b==c) continue ;
- if (b==d) continue ;
- if (c==d) continue ;
-
- if (b<a) continue ;
- if (c<a) continue ;
- if (d<a) continue ;
- if (d<c) continue ;
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- djack[k] = dump4(top, a, b, c, d, numeg) ;
- }
-
- mean = dump4(gtop, a, b, c, d, numeg) ;
- wjackest(&jest, &jsig, mean, djack, wjack, nblocks) ;
- bump4x(f4sig, a, b, c, d, numeg, jsig) ;
- bump4x(f4sig, b, a, c, d, numeg, jsig) ;
- }
- }
+
+ ZALLOC(w1, numeg, double);
+ ZALLOC(w2, numeg, double);
+ ZALLOC(w3, numeg, double);
+ ZALLOC(gtop, numeg, double);
+ ZALLOC(gbot, numeg, double);
+ ZALLOC(wtop, numeg, double);
+ ZALLOC(wbot, numeg, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ ZALLOC(ztop, numeg, double);
+ ZALLOC(zbot, numeg, double);
+ btop = initarray_2Ddouble (nblocks, numeg, 0.0);
+ bbot = initarray_2Ddouble (nblocks, numeg, 0.0);
+
+ vzero (inb, numeg);
+ vzero (inbest, numeg);
+ vzero (inbsig, numeg);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ if (cupt->ignore)
+ continue;
+ wt = cupt->weight;
+ if (wt <= 0.0)
+ continue;
+ bnum = cupt->tagnumber;
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+
+ fstcolinb (ztop, zbot, cupt, xindex, xtypes, nrows, numeg);
+
+ for (a = 0; a < numeg; a++)
+ {
+ k = a;
+ ytop = ztop[k];
+ ybot = zbot[k];
+
+ if (ybot < 0.0)
+ continue;
+
+ top[k] += ytop;
+ bot[k] += ybot;
+
+ w1[k] += ytop;
+ w2[k] += ybot;
+ }
}
- }
- vst(f4, f4, scale, ng4) ;
- vst(f4sig, f4sig, scale, ng4) ;
- free(w1) ;
- free(w2) ;
- free(w3) ;
-
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(djack) ;
- free(wjack) ;
-
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
-
-}
-
-void bump4x(double *x, int a, int b, int c, int d, int n, double val)
-{
- bump4(x, a, b, c, d, n, val) ;
- bump4(x, b, a, d, c, n, val) ;
- bump4(x, c, d, a, b, n, val) ;
- bump4(x, d, c, b, a, n, val) ;
-}
-
-void bump4(double *x, int a, int b, int c, int d, int n, double val)
-{
- int k ;
- k = a ;
- k *= n ;
- k += b ;
- k *= n ;
- k += c ;
- k *= n ;
- k += d ;
- x[k] += val ;
-}
-void set4x(double *x, int a, int b, int c, int d, int n, double val)
-{
- set4(x, a, b, c, d, n, val) ;
- set4(x, b, a, d, c, n, val) ;
- set4(x, c, d, a, b, n, val) ;
- set4(x, d, c, b, a, n, val) ;
-}
-
-void set4(double *x, int a, int b, int c, int d, int n, double val)
-{
- int k ;
- k = a ;
- k *= n ;
- k += b ;
- k *= n ;
- k += c ;
- k *= n ;
- k += d ;
- x[k] = val ;
-}
-
-double dump4(double *x, int a, int b, int c, int d, int n)
-{
- int k ;
- double val ;
- k = a ;
- k *= n ;
- k += b ;
- k *= n ;
- k += c ;
- k *= n ;
- k += d ;
- val = x[k] ;
- return val ;
-}
-
-double doinbreed(double *inb, double *inbest, double *inbsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, Indiv **indivmarkers)
-
-{
-
- int t1, t2 ;
- int a, b ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int t, k, g, i, col, j ;
- double ya, yb, y, jest, jsig, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot, wt ;
- double *w1, *w2, *w3 ;
- double ytop, ybot ;
- double y1, y2, yscal ;
- int bnum ;
- int nloop = 0, fstdnum =0 ;
- double *ztop, *zbot, qtop, qbot ;
- char **eglist ;
-
- indm = indivmarkers ;
-
- ZALLOC(eglist, numeg, char *) ;
- for (k=0; k< nrows; ++k) {
- if (indm == NULL) break ;
- j = xtypes[k] ;
- if (j<0) continue ;
- if (j>=numeg) continue ;
- t = xindex[k] ;
- eglist[j] = indm[t] -> egroup ;
- }
-
- ZALLOC(w1, numeg, double) ;
- ZALLOC(w2, numeg, double) ;
- ZALLOC(w3, numeg, double) ;
- ZALLOC(gtop, numeg, double) ;
- ZALLOC(gbot, numeg, double) ;
- ZALLOC(wtop, numeg, double) ;
- ZALLOC(wbot, numeg, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- ZALLOC(ztop, numeg, double) ;
- ZALLOC(zbot, numeg, double) ;
- btop = initarray_2Ddouble(nblocks, numeg, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, numeg, 0.0) ;
-
- vzero(inb, numeg) ;
- vzero(inbest, numeg) ;
- vzero(inbsig, numeg) ;
-
-
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- if (cupt -> ignore) continue ;
- wt = cupt -> weight ;
- if (wt <= 0.0) continue ;
- bnum = cupt -> tagnumber ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
-
- fstcolinb(ztop, zbot, cupt, xindex, xtypes, nrows, numeg) ;
-
- for (a=0; a<numeg ; a++) {
- k = a ;
- ytop = ztop[k] ;
- ybot = zbot[k] ;
-
- if (ybot<0.0) continue ;
-
- top[k] += ytop ;
- bot[k] += ybot ;
-
- w1[k] += ytop ;
- w2[k] += ybot ;
- }
- }
-
+ vsp (w2, w2, 1.0e-10, numeg);
+ vvd (inb, w1, w2, numeg);
- vsp(w2, w2, 1.0e-10, numeg) ;
- vvd(inb, w1, w2, numeg) ;
-
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, numeg);
+ vvp (gbot, gbot, bot, numeg);
+ }
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, numeg) ;
- vvp(gbot, gbot, bot, numeg) ;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, numeg);
+ vvm (wbot, gbot, bot, numeg);
+ vsp (wbot, wbot, 1.0e-10, numeg);
+ vvd (top, wtop, wbot, numeg); // delete-block estimate
}
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, numeg) ;
- vvm(wbot, gbot, bot, numeg) ;
- vsp(wbot, wbot, 1.0e-10, numeg) ;
- vvd(top, wtop, wbot, numeg) ; // delete-block estimate
+ vsp (gbot, gbot, 1.0e-10, numeg);
+ vvd (gtop, gtop, gbot, numeg);
+
+ /**
+ printf("zzinb\n") ;
+ printmat(inb, 1, numeg) ;
+ printnl() ;
+ printmat(gtop, 1, numeg) ;
+ */
+
+ for (i = 0; i < numeg; i++)
+ {
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ djack[k] = top[i];
+ }
+
+ ++nloop;
+ mean = gtop[i];
+ wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
+
+ inbest[i] = jest;
+ inbsig[i] = jsig;
+
+ if (nloop == -1)
+ {
+ printf ("inbreedest\n");
+ printf ("mean: %9.3f\n", mean);
+ printmat (djack, 1, nblocks);
+ printnl ();
+ printmat (wjack, 1, nblocks);
+ printf ("%9.3f %9.3f\n", jest, jsig);
+ }
}
- vsp(gbot, gbot, 1.0e-10, numeg) ;
- vvd(gtop, gtop, gbot, numeg) ;
+ free (eglist);
+ free (w1);
+ free (w2);
+ free (w3);
-
-/**
- printf("zzinb\n") ;
- printmat(inb, 1, numeg) ;
- printnl() ;
- printmat(gtop, 1, numeg) ;
-*/
-
-
- for (i=0; i<numeg; i++) {
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- djack[k] = top[i] ;
- }
-
- ++nloop ;
- mean = gtop[i] ;
- wjackest(&jest, &jsig, mean, djack, wjack, nblocks) ;
-
- inbest[i] = jest ;
- inbsig[i] = jsig ;
-
- if (nloop == -1) {
- printf("inbreedest\n") ;
- printf("mean: %9.3f\n", mean) ;
- printmat(djack, 1, nblocks) ;
- printnl() ;
- printmat(wjack, 1, nblocks) ;
- printf("%9.3f %9.3f\n", jest, jsig) ;
- }
- }
-
-
- free(eglist) ;
- free(w1) ;
- free(w2) ;
- free(w3) ;
-
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(ztop) ;
- free(zbot) ;
- free(djack) ;
- free(wjack) ;
-
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
-
- return ;
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (ztop);
+ free (zbot);
+ free (djack);
+ free (wjack);
+
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
+
+ return;
}
double
-dofstnumx(double *fst, double *fstest, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks, Indiv **indivmarkers, int fstmode)
+dofstnumx (double *fst, double *fstest, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks, Indiv **indivmarkers, int fstmode)
// fstmode is classic mode (smartpca)
// fstmode 2 is fstdmode
{
- int t1, t2 ;
- int a, b ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int t, k, g, i, col, j ;
- double ya, yb, y, jest, jsig, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot, wt ;
- double *w1, *w2, *w3 ;
- double ytop, ybot ;
- double y1, y2, yscal ;
- int bnum ;
- int nloop = 0, fstdnum =0 ;
- double *ztop, *zbot, qtop, qbot ;
- char **eglist ;
-
- indm = indivmarkers ;
- if ((fstdetails != NULL) && (indm == NULL)) fatalx("bug in dofstnumx\n") ;
-
- ZALLOC(eglist, numeg, char *) ;
- for (k=0; k< nrows; ++k) {
- if (indm == NULL) break ;
- j = xtypes[k] ;
- if (j<0) continue ;
- if (j>=numeg) continue ;
- t = xindex[k] ;
- eglist[j] = indm[t] -> egroup ;
- }
-
- ZALLOC(w1, numeg*numeg, double) ;
- ZALLOC(w2, numeg*numeg, double) ;
- ZALLOC(w3, numeg*numeg, double) ;
- ZALLOC(gtop, numeg*numeg, double) ;
- ZALLOC(gbot, numeg*numeg, double) ;
- ZALLOC(wtop, numeg*numeg, double) ;
- ZALLOC(wbot, numeg*numeg, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- ZALLOC(ztop, numeg*numeg, double) ;
- ZALLOC(zbot, numeg*numeg, double) ;
- btop = initarray_2Ddouble(nblocks, numeg*numeg, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, numeg*numeg, 0.0) ;
-
- if (nblocks ==1 ) printf("number of blocks 1: no standard error\n") ;
-
- vzero(fst, numeg*numeg) ;
- vzero(fstest, numeg*numeg) ;
- vzero(fstsig, numeg*numeg) ;
-
-
- for (col=0; col<ncols; ++col) {
- cupt = xsnplist[col] ;
- if (cupt -> ignore) continue ;
- wt = cupt -> weight ;
- if (wt <= 0.0) continue ;
- bnum = cupt -> tagnumber ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
-
- fstcolyy(ztop, zbot, cupt, xindex, xtypes, nrows, numeg) ;
-
- for (a=0; a<numeg ; a++) {
- for (b=a+1; b<numeg ; b++) {
- k = a*numeg+b ;
- ytop = ztop[k] ;
- ybot = zbot[k] ;
- if (fstdetails != NULL) {
- if (fstdnum==0) {
- fprintf(fstdetails,"%20s ", "## pop 1") ;
- fprintf(fstdetails,"%20s ", "pop 2") ;
- fprintf(fstdetails,"%20s ", "snpname") ;
- fprintf(fstdetails,"%20s ", "N") ;
- fprintf(fstdetails,"%20s ", "D") ;
- fprintf(fstdetails,"%12s ", "Ratio") ;
- fprintf(fstdetails, "\n") ;
- }
- fprintf(fstdetails,"%20s ", eglist[a]) ;
- fprintf(fstdetails,"%20s ", eglist[b]) ;
- fprintf(fstdetails,"%20s ", cupt -> ID) ;
- fprintf(fstdetails,"%12.6f ", ytop) ;
- fprintf(fstdetails,"%12.6f ", ybot) ;
- if (ybot>0.0)
- fprintf(fstdetails,"%12.6f", ytop/ybot) ;
- else
- fprintf(fstdetails,"%12s", "-") ;
- fprintf(fstdetails, "\n") ;
- ++fstdnum ;
- }
-
-
- if (ybot<0.0) continue ;
-
-
- if (fstmode == NO) {
- top[k] += wt*ytop ;
- bot[k] += 1.0 ;
- }
-
- if (fstmode == YES) {
- top[k] += ytop ;
- bot[k] += ybot ;
- }
-
- if (fstmode == 2) {
- top[k] += ytop ;
- bot[k] += 1.0/wt ;
- }
-
- w1[k] += ytop ;
- w2[k] += ybot ;
+ int t1, t2;
+ int a, b;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int t, k, g, i, col, j;
+ double ya, yb, y, jest, jsig, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot, wt;
+ double *w1, *w2, *w3;
+ double ytop, ybot;
+ double y1, y2, yscal;
+ int bnum;
+ int nloop = 0, fstdnum = 0;
+ double *ztop, *zbot, qtop, qbot;
+ char **eglist;
+
+ indm = indivmarkers;
+ if ((fstdetails != NULL) && (indm == NULL))
+ fatalx ("bug in dofstnumx\n");
+
+ ZALLOC(eglist, numeg, char *);
+ for (k = 0; k < nrows; ++k)
+ {
+ if (indm == NULL)
+ break;
+ j = xtypes[k];
+ if (j < 0)
+ continue;
+ if (j >= numeg)
+ continue;
+ t = xindex[k];
+ eglist[j] = indm[t]->egroup;
+ }
+
+ ZALLOC(w1, numeg*numeg, double);
+ ZALLOC(w2, numeg*numeg, double);
+ ZALLOC(w3, numeg*numeg, double);
+ ZALLOC(gtop, numeg*numeg, double);
+ ZALLOC(gbot, numeg*numeg, double);
+ ZALLOC(wtop, numeg*numeg, double);
+ ZALLOC(wbot, numeg*numeg, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ ZALLOC(ztop, numeg*numeg, double);
+ ZALLOC(zbot, numeg*numeg, double);
+ btop = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
+ bbot = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
+
+ if (nblocks == 1)
+ printf ("number of blocks 1: no standard error\n");
+
+ vzero (fst, numeg * numeg);
+ vzero (fstest, numeg * numeg);
+ vzero (fstsig, numeg * numeg);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ cupt = xsnplist[col];
+ if (cupt->ignore)
+ continue;
+ wt = cupt->weight;
+ if (wt <= 0.0)
+ continue;
+ bnum = cupt->tagnumber;
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+
+ fstcolyy (ztop, zbot, cupt, xindex, xtypes, nrows, numeg);
+
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = a + 1; b < numeg; b++)
+ {
+ k = a * numeg + b;
+ ytop = ztop[k];
+ ybot = zbot[k];
+ if (fstdetails != NULL)
+ {
+ if (fstdnum == 0)
+ {
+ fprintf (fstdetails, "%20s ", "## pop 1");
+ fprintf (fstdetails, "%20s ", "pop 2");
+ fprintf (fstdetails, "%20s ", "snpname");
+ fprintf (fstdetails, "%20s ", "N");
+ fprintf (fstdetails, "%20s ", "D");
+ fprintf (fstdetails, "%12s ", "Ratio");
+ fprintf (fstdetails, "\n");
+ }
+ fprintf (fstdetails, "%20s ", eglist[a]);
+ fprintf (fstdetails, "%20s ", eglist[b]);
+ fprintf (fstdetails, "%20s ", cupt->ID);
+ fprintf (fstdetails, "%12.6f ", ytop);
+ fprintf (fstdetails, "%12.6f ", ybot);
+ if (ybot > 0.0)
+ fprintf (fstdetails, "%12.6f", ytop / ybot);
+ else
+ fprintf (fstdetails, "%12s", "-");
+ fprintf (fstdetails, "\n");
+ ++fstdnum;
+ }
+
+ if (ybot < 0.0)
+ continue;
+
+ if (fstmode == NO)
+ {
+ top[k] += wt * ytop;
+ bot[k] += 1.0;
+ }
+
+ if (fstmode == YES)
+ {
+ top[k] += ytop;
+ bot[k] += ybot;
+ }
+
+ if (fstmode == 2)
+ {
+ top[k] += ytop;
+ bot[k] += 1.0 / wt;
+ }
+
+ w1[k] += ytop;
+ w2[k] += ybot;
// classic fst estimate
- }
+ }
+ }
}
- }
// symmetrize
- for (a=0; a<numeg ; a++) {
- for (b=a+1; b<numeg ; b++) {
- top[b*numeg+a] = top[a*numeg+b] ;
- bot[b*numeg+a] = bot[a*numeg+b] ;
- w1[b*numeg+a] = w1[a*numeg+b] ;
- w2[b*numeg+a] = w2[a*numeg+b] ;
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = a + 1; b < numeg; b++)
+ {
+ top[b * numeg + a] = top[a * numeg + b];
+ bot[b * numeg + a] = bot[a * numeg + b];
+ w1[b * numeg + a] = w1[a * numeg + b];
+ w2[b * numeg + a] = w2[a * numeg + b];
+ }
}
- }
-
-
- vsp(w2, w2, 1.0e-10, numeg*numeg) ;
- vvd(fst, w1, w2, numeg*numeg) ;
-
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, numeg*numeg) ;
- vvp(gbot, gbot, bot, numeg*numeg) ;
- }
-
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, numeg*numeg) ;
- vvm(wbot, gbot, bot, numeg*numeg) ;
- vsp(wbot, wbot, 1.0e-10, numeg*numeg) ;
- vvd(top, wtop, wbot, numeg*numeg) ; // delete-block estimate
- }
- vsp(gbot, gbot, 1.0e-10, numeg*numeg) ;
- vvd(gtop, gtop, gbot, numeg*numeg) ;
-
-
- for (i=0; i<numeg; i++) {
- for (j=i+1; j<numeg ; j++) {
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- djack[k] = top[i*numeg+j] ;
- }
-
- ++nloop ;
- mean = gtop[i*numeg+j] ;
- jest = mean ; jsig = 0 ;
- if (nblocks > 1) {
- wjackest(&jest, &jsig, mean, djack, wjack, nblocks) ;
- }
- fstest[i*numeg+j] = fstest[j*numeg+i] = jest ;
- fstsig[i*numeg+j] = fstsig[j*numeg+i] = jsig ;
-
- if (nloop == -1) {
- printf("fstest\n") ;
- printf("mean: %9.3f\n", mean) ;
- printmat(djack, 1, nblocks) ;
- printnl() ;
- printmat(wjack, 1, nblocks) ;
- printf("%9.3f %9.3f\n", jest, jsig) ;
- }
- }
+
+ vsp (w2, w2, 1.0e-10, numeg * numeg);
+ vvd (fst, w1, w2, numeg * numeg);
+
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, numeg * numeg);
+ vvp (gbot, gbot, bot, numeg * numeg);
}
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, numeg * numeg);
+ vvm (wbot, gbot, bot, numeg * numeg);
+ vsp (wbot, wbot, 1.0e-10, numeg * numeg);
+ vvd (top, wtop, wbot, numeg * numeg); // delete-block estimate
+ }
+ vsp (gbot, gbot, 1.0e-10, numeg * numeg);
+ vvd (gtop, gtop, gbot, numeg * numeg);
+
+ for (i = 0; i < numeg; i++)
+ {
+ for (j = i + 1; j < numeg; j++)
+ {
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ djack[k] = top[i * numeg + j];
+ }
+
+ ++nloop;
+ mean = gtop[i * numeg + j];
+ jest = mean;
+ jsig = 0;
+ if (nblocks > 1)
+ {
+ wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
+ }
+ fstest[i * numeg + j] = fstest[j * numeg + i] = jest;
+ fstsig[i * numeg + j] = fstsig[j * numeg + i] = jsig;
+
+ if (nloop == -1)
+ {
+ printf ("fstest\n");
+ printf ("mean: %9.3f\n", mean);
+ printmat (djack, 1, nblocks);
+ printnl ();
+ printmat (wjack, 1, nblocks);
+ printf ("%9.3f %9.3f\n", jest, jsig);
+ }
+ }
+ }
-/**
+ /**
printf("fst:\n") ;
printmat(fst, numeg, numeg) ;
printnl() ;
@@ -2453,567 +2727,652 @@ dofstnumx(double *fst, double *fstest, double *fstsig, SNP **xsnplist, int *xind
printnl() ;
printmat(fstsig, numeg, numeg) ;
printnl() ;
-*/
-
- yscal = 1.0 ;
- if (fstmode != YES) {
- copyarr(fstsig, w3, numeg*numeg) ;
- vsp(w3, w3, 1.0e-10, numeg*numeg) ;
- vvd(w1, fst, w3, numeg*numeg) ;
- vvd(w2, fstest, w3, numeg*numeg) ;
+ */
+
+ yscal = 1.0;
+ if (fstmode != YES)
+ {
+ copyarr (fstsig, w3, numeg * numeg);
+ vsp (w3, w3, 1.0e-10, numeg * numeg);
+ vvd (w1, fst, w3, numeg * numeg);
+ vvd (w2, fstest, w3, numeg * numeg);
// now do regression w1 = yscal * w2
- y1 = vdot(w1, w2, numeg*numeg) ;
- y2 = vdot(w2, w2, numeg*numeg) ;
- yscal = y1/y2 ;
- vst(fstest, fstest, yscal, numeg*numeg) ;
- vst(fstsig, fstsig, yscal, numeg*numeg) ;
+ y1 = vdot (w1, w2, numeg * numeg);
+ y2 = vdot (w2, w2, numeg * numeg);
+ yscal = y1 / y2;
+ vst (fstest, fstest, yscal, numeg * numeg);
+ vst (fstsig, fstsig, yscal, numeg * numeg);
}
- free(eglist) ;
- free(w1) ;
- free(w2) ;
- free(w3) ;
+ free (eglist);
+ free (w1);
+ free (w2);
+ free (w3);
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(ztop) ;
- free(zbot) ;
- free(djack) ;
- free(wjack) ;
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (ztop);
+ free (zbot);
+ free (djack);
+ free (wjack);
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
- return yscal ;
+ return yscal;
}
double
-dofstnum(double *fst, double *fstest, double *fstsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int nblocks)
+dofstnum (double *fst, double *fstest, double *fstsig, SNP **xsnplist,
+ int *xindex, int *xtypes, int nrows, int ncols, int numeg,
+ int nblocks)
{
- dofstnumx(fst, fstest, fstsig, xsnplist, xindex, xtypes, nrows, ncols, numeg, nblocks, NULL, NO) ;
+ dofstnumx (fst, fstest, fstsig, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, NULL, NO);
}
-void setmgpos(SNP **snpm, int numsnps, double *maxgdis)
+void
+setmgpos (SNP **snpm, int numsnps, double *maxgdis)
// find max genetic distance
{
- double minpos, maxdis ;
- int chrom, lchrom, i ;
- SNP *cupt ;
-
- minpos = 99999.0 ;
- lchrom = -1 ;
-
- maxdis = -9999 ;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- chrom = cupt -> chrom ;
- if (chrom != lchrom) {
- lchrom = chrom ;
- minpos = cupt -> genpos ;
- }
- maxdis = MAX(maxdis, cupt -> genpos - minpos) ;
- }
- *maxgdis = maxdis ;
+ double minpos, maxdis;
+ int chrom, lchrom, i;
+ SNP *cupt;
+
+ minpos = 99999.0;
+ lchrom = -1;
+
+ maxdis = -9999;
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ chrom = cupt->chrom;
+ if (chrom != lchrom)
+ {
+ lchrom = chrom;
+ minpos = cupt->genpos;
+ }
+ maxdis = MAX(maxdis, cupt->genpos - minpos);
+ }
+ *maxgdis = maxdis;
}
-void setgfromp(SNP **snpm, int numsnps)
+void
+setgfromp (SNP **snpm, int numsnps)
{
- int i ;
- SNP *cupt ;
-
+ int i;
+ SNP *cupt;
- for (i=0; i<numsnps; i++) {
- cupt = snpm[i] ;
- cupt -> genpos = (cupt -> physpos) / 1.0e8 ;
- }
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpm[i];
+ cupt->genpos = (cupt->physpos) / 1.0e8;
+ }
}
-void wjackest(double *est, double *sig, double mean, double *jmean, double *jwt, int g)
+void
+wjackest (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g)
// test for jwt 0
{
- double *jjmean, *jjwt ;
- int i, n ;
+ double *jjmean, *jjwt;
+ int i, n;
- ZALLOC(jjmean, g, double) ;
- ZALLOC(jjwt, g, double) ;
- n = 0 ;
+ ZALLOC(jjmean, g, double);
+ ZALLOC(jjwt, g, double);
+ n = 0;
- for (i=0; i<g ; ++i) {
- if (jwt[i] < 1.0e-6) continue ;
- jjmean[n] = jmean[i] ;
- jjwt[n] = jwt[i] ;
- ++n ;
- }
+ for (i = 0; i < g; ++i)
+ {
+ if (jwt[i] < 1.0e-6)
+ continue;
+ jjmean[n] = jmean[i];
+ jjwt[n] = jwt[i];
+ ++n;
+ }
- wjackestx(est, sig, mean, jjmean, jjwt, n) ;
- free(jjmean) ;
- free(jjwt) ;
+ wjackestx (est, sig, mean, jjmean, jjwt, n);
+ free (jjmean);
+ free (jjwt);
}
-static void wjackestx(double *est, double *sig, double mean, double *jmean, double *jwt, int g)
+static void
+wjackestx (double *est, double *sig, double mean, double *jmean, double *jwt,
+ int g)
// weighted jackknife see wjack.tex
// mean is natural estimate. jmean[k] mean with block k removed. jwt is weight for block (sample size)
{
- double *tdiff, *hh, *xtau, *w1, *w2 ;
- double jackest, yn, yvar ;
- int k ;
+ double *tdiff, *hh, *xtau, *w1, *w2;
+ double jackest, yn, yvar;
+ int k;
+
+ if (g <= 1)
+ fatalx ("(wjackest) number of blocks <= 1\n");
+ ZALLOC(tdiff, g, double);
+ ZALLOC(hh, g, double);
+ ZALLOC(xtau, g, double);
+ ZALLOC(w1, g, double);
+ ZALLOC(w2, g, double);
- if (g<=1) fatalx("(wjackest) number of blocks <= 1\n") ;
- ZALLOC(tdiff, g, double) ;
- ZALLOC(hh, g, double) ;
- ZALLOC(xtau, g, double) ;
- ZALLOC(w1, g, double) ;
- ZALLOC(w2, g, double) ;
+ yn = asum (jwt, g);
- yn = asum(jwt, g) ;
-
- vsp(tdiff, jmean, -mean, g) ;
- vst(tdiff, tdiff, -1.0, g) ;
- jackest = asum(tdiff, g) + vdot(jwt, jmean, g)/yn ;
+ vsp (tdiff, jmean, -mean, g);
+ vst (tdiff, tdiff, -1.0, g);
+ jackest = asum (tdiff, g) + vdot (jwt, jmean, g) / yn;
// this is equation 2
- vclear(hh, yn, g) ;
- vvd(hh, hh, jwt, g) ;
-/**
- for (k=0; k<g; ++k) {
+ vclear (hh, yn, g);
+ vvd (hh, hh, jwt, g);
+ /**
+ for (k=0; k<g; ++k) {
if (jwt[k] > 0.0) hh[k] /= jwt[k] ;
else hh[k] *= 1.0e20 ;
- }
-*/
+ }
+ */
// jwt should be positive
+ vst (xtau, hh, mean, g);
+ vsp (w1, hh, -1.0, g);
+ vvt (w2, w1, jmean, g);
+ vvm (xtau, xtau, w2, g);
- vst(xtau, hh, mean, g) ;
- vsp(w1, hh, -1.0, g) ;
- vvt(w2, w1, jmean, g) ;
- vvm(xtau, xtau, w2, g) ;
-
- vsp(xtau, xtau, -jackest, g) ;
- vvt (xtau, xtau, xtau, g) ;
- vvd (xtau, xtau, w1, g) ;
- yvar = asum(xtau, g) / (double) g ;
- *est = jackest ;
- *sig = sqrt(yvar) ;
+ vsp (xtau, xtau, -jackest, g);
+ vvt (xtau, xtau, xtau, g);
+ vvd (xtau, xtau, w1, g);
+ yvar = asum (xtau, g) / (double) g;
+ *est = jackest;
+ *sig = sqrt (yvar);
- free(tdiff) ;
- free(hh) ;
- free(xtau) ;
- free(w1) ;
- free(w2) ;
+ free (tdiff);
+ free (hh);
+ free (xtau);
+ free (w1);
+ free (w2);
}
-void ndfst5(double *zzest, double *zzsig, double **zn, double **zd, int ncols, int *bcols, int nblocks)
+void
+ndfst5 (double *zzest, double *zzsig, double **zn, double **zd, int ncols,
+ int *bcols, int nblocks)
{
#define NPAR 5
- double *djack, *wjack ;
- double qest, jest, jsig ;
- double y1, y2 ;
- int bnum, i, k ;
- int a, b, c ;
- double *gn, *gd, **xn, **xd, *xx, *qqest, *test, *tn, *td, **xqest ;
-
- ZALLOC(gn, 4*4, double) ;
- ZALLOC(gd, 4*4, double) ;
- ZALLOC(tn, 4*4, double) ;
- ZALLOC(td, 4*4, double) ;
- ZALLOC(qqest, NPAR, double) ;
-
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
-
- xn = initarray_2Ddouble(nblocks, 4*4, 0.0) ;
- xd = initarray_2Ddouble(nblocks, 4*4, 0.0) ;
- xqest = initarray_2Ddouble(nblocks, NPAR, 0.0) ;
-
-
- for (i=0; i<ncols; i++) {
- bnum = bcols[i] ;
- if (bnum<0) continue ;
- if (bnum>=nblocks) fatalx("bad bug\n") ;
- ++wjack[bnum] ;
- for (a=0; a<4; a++) {
- for (b=a+1; b<4; b++) {
- c = 4*a+b ;
- xn[bnum][c] += zn[i][c] ;
- xd[bnum][c] += zd[i][c] ;
- }
+ double *djack, *wjack;
+ double qest, jest, jsig;
+ double y1, y2;
+ int bnum, i, k;
+ int a, b, c;
+ double *gn, *gd, **xn, **xd, *xx, *qqest, *test, *tn, *td, **xqest;
+
+ ZALLOC(gn, 4*4, double);
+ ZALLOC(gd, 4*4, double);
+ ZALLOC(tn, 4*4, double);
+ ZALLOC(td, 4*4, double);
+ ZALLOC(qqest, NPAR, double);
+
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+
+ xn = initarray_2Ddouble (nblocks, 4 * 4, 0.0);
+ xd = initarray_2Ddouble (nblocks, 4 * 4, 0.0);
+ xqest = initarray_2Ddouble (nblocks, NPAR, 0.0);
+
+ for (i = 0; i < ncols; i++)
+ {
+ bnum = bcols[i];
+ if (bnum < 0)
+ continue;
+ if (bnum >= nblocks)
+ fatalx ("bad bug\n");
+ ++wjack[bnum];
+ for (a = 0; a < 4; a++)
+ {
+ for (b = a + 1; b < 4; b++)
+ {
+ c = 4 * a + b;
+ xn[bnum][c] += zn[i][c];
+ xd[bnum][c] += zd[i][c];
+ }
+ }
}
- }
- for (k=0; k<nblocks; k++) {
- xx = xn[k] ;
- vvp(gn, gn, xx, 4*4) ;
- xx = xd[k] ;
- vvp(gd, gd, xx, 4*4) ;
- }
- verbose = YES ;
- regestit(qqest, gn, gd) ;
- printf("qqest: ") ;
- printmatw(qqest, 1, 5, 5) ;
- verbose = NO ;
-
- for (k=0; k<nblocks; k++) {
- xx = xn[k] ;
- vvm(tn, gn, xx, 4*4) ;
- xx = xd[k] ;
- vvm(td, gd, xx, 4*4) ;
- regestit(xqest[k], tn, td) ;
- }
- for (a=0; a<NPAR; a++) {
- for (k=0; k<nblocks; ++k) {
- djack[k] = xqest[k][a] ;
+ for (k = 0; k < nblocks; k++)
+ {
+ xx = xn[k];
+ vvp (gn, gn, xx, 4 * 4);
+ xx = xd[k];
+ vvp (gd, gd, xx, 4 * 4);
}
- wjackest(&jest, &jsig, qqest[a], djack, wjack, nblocks) ;
- zzest[a] = jest ;
- zzsig[a] = jsig ;
- }
-
- free2D(&xqest, nblocks) ;
- free2D(&xn, nblocks) ;
- free2D(&xd, nblocks) ;
- free(djack) ;
- free(wjack) ;
- free(gn) ;
- free(gd) ;
- free(tn) ;
- free(td) ;
- free(qqest) ;
+ verbose = YES;
+ regestit (qqest, gn, gd);
+ printf ("qqest: ");
+ printmatw (qqest, 1, 5, 5);
+ verbose = NO;
+
+ for (k = 0; k < nblocks; k++)
+ {
+ xx = xn[k];
+ vvm (tn, gn, xx, 4 * 4);
+ xx = xd[k];
+ vvm (td, gd, xx, 4 * 4);
+ regestit (xqest[k], tn, td);
+ }
+ for (a = 0; a < NPAR; a++)
+ {
+ for (k = 0; k < nblocks; ++k)
+ {
+ djack[k] = xqest[k][a];
+ }
+ wjackest (&jest, &jsig, qqest[a], djack, wjack, nblocks);
+ zzest[a] = jest;
+ zzsig[a] = jsig;
+ }
+
+ free2D (&xqest, nblocks);
+ free2D (&xn, nblocks);
+ free2D (&xd, nblocks);
+ free (djack);
+ free (wjack);
+ free (gn);
+ free (gd);
+ free (tn);
+ free (td);
+ free (qqest);
}
-void regestit(double *ans, double *xn, double *xd)
+void
+regestit (double *ans, double *xn, double *xd)
{
- int a, b, c, k ;
- double *co, *rr ;
- double f ;
-
- ZALLOC(co, 6*5, double) ;
- ZALLOC(rr, 6, double) ;
-
-/**
- printf("zzreg\n") ;
- printmat(xn, 4, 4) ;
- printnl() ;
- printmat(xd, 4, 4) ;
- printnl() ;
-*/
-
- verbose = NO ;
-
- k=0; a=0; b=1;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+0] = co[k*5+1] = 1 ;
- rr[k] = f ;
-
- k=1; a=2; b=3;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+3] = co[k*5+4] = 1 ;
- rr[k] = f ;
+ int a, b, c, k;
+ double *co, *rr;
+ double f;
- k=2; a=0; b=2;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+0] = co[k*5+2] = co[k*5+3] = 1 ;
- rr[k] = f ;
+ ZALLOC(co, 6*5, double);
+ ZALLOC(rr, 6, double);
- k=3; a=0; b=3;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+0] = co[k*5+2] = co[k*5+4] = 1 ;
- rr[k] = f ;
-
- k=4; a=1; b=2;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+1] = co[k*5+2] = co[k*5+3] = 1 ;
- rr[k] = f ;
-
- k=5; a=1; b=3;
- c = 4*a+b ; f = xn[c]/xd[c] ;
- co[k*5+1] = co[k*5+2] = co[k*5+4] = 1 ;
- rr[k] = f ;
-
- regressit(ans, co, rr, 6, 5) ;
-
- free(co) ;
- free(rr) ;
+ /**
+ printf("zzreg\n") ;
+ printmat(xn, 4, 4) ;
+ printnl() ;
+ printmat(xd, 4, 4) ;
+ printnl() ;
+ */
+
+ verbose = NO;
+
+ k = 0;
+ a = 0;
+ b = 1;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 0] = co[k * 5 + 1] = 1;
+ rr[k] = f;
+
+ k = 1;
+ a = 2;
+ b = 3;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 3] = co[k * 5 + 4] = 1;
+ rr[k] = f;
+
+ k = 2;
+ a = 0;
+ b = 2;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 0] = co[k * 5 + 2] = co[k * 5 + 3] = 1;
+ rr[k] = f;
+
+ k = 3;
+ a = 0;
+ b = 3;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 0] = co[k * 5 + 2] = co[k * 5 + 4] = 1;
+ rr[k] = f;
+
+ k = 4;
+ a = 1;
+ b = 2;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 1] = co[k * 5 + 2] = co[k * 5 + 3] = 1;
+ rr[k] = f;
+
+ k = 5;
+ a = 1;
+ b = 3;
+ c = 4 * a + b;
+ f = xn[c] / xd[c];
+ co[k * 5 + 1] = co[k * 5 + 2] = co[k * 5 + 4] = 1;
+ rr[k] = f;
+
+ regressit (ans, co, rr, 6, 5);
+
+ free (co);
+ free (rr);
}
void
-setwt(SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
- int *xindex, int *xtypes, char *outpop, char **eglist, int numeg)
-{
- int *rawcol ;
- SNP *cupt ;
- int i, k, j, t, kk, maxeg ;
- int a0, a1, aa ;
- int **ccx, **ccc, *cc ;
- double wt, p ;
- int a, g ;
-
- t = strcmp(outpop, "NONE") ;
- if (t==0) outnum = -1 ;
- maxeg = MAX(outnum, numeg) + 1 ;
- ccx = initarray_2Dint(maxeg, 2, 0) ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- t = -1 ;
+setwt (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
+ int *xindex, int *xtypes, char *outpop, char **eglist, int numeg)
+{
+ int *rawcol;
+ SNP *cupt;
+ int i, k, j, t, kk, maxeg;
+ int a0, a1, aa;
+ int **ccx, **ccc, *cc;
+ double wt, p;
+ int a, g;
+
+ t = strcmp (outpop, "NONE");
+ if (t == 0)
+ outnum = -1;
+ maxeg = MAX(outnum, numeg) + 1;
+ ccx = initarray_2Dint (maxeg, 2, 0);
+ ccc = initarray_2Dint (nrows, 2, 0);
+ t = -1;
// printf("zzqq %d %d\n", outnum, numeg) ;
- for (i=0; i<numsnps; ++i) {
- cupt = snpmarkers[i] ;
- cupt -> weight = 0 ;
+ for (i = 0; i < numsnps; ++i)
+ {
+ cupt = snpmarkers[i];
+ cupt->weight = 0;
// t = strcmp(cupt -> ID, "rs10914979") ;
- if (cupt -> ignore) continue ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- iclear2D(&ccx, maxeg, 2, 0) ;
- for (k=0; k<nrows; ++k) {
- a = xtypes[k] ;
-
- if (i==-1) {
- printf("zzq %d %d %d %d\n", i, k, outnum, ccc[k][0]) ;
- }
-
- if (a<0) continue ;
- if (a>=maxeg) continue ;
- g = ccc[k][0] ;
- if (g<0) continue ;
- cc = ccx[a] ;
- ivvp(cc, cc, ccc[k], 2) ;
- }
-
- if (outnum<0) {
- a0 = a1 = 0 ;
- for (j=0; j< numeg; ++j) {
- a0 += ccx[j][0] ;
- a1 += ccx[j][1] ;
- }
- }
-
- else {
- a0 = ccx[outnum][0] ;
- a1 = ccx[outnum][1] ;
- }
-
- aa = a0 + a1 ;
- if (a0==0) continue ;
- if (a1==0) continue ;
- p = (double) a0 / (double) aa ;
- wt = 1.0/(p*(1.0-p)) ;
- if (outnum == -99) wt = 1.0 ;
-
- if (t==0) {
- for (k=0; k<nrows; ++k) {
- printf("ww1: %d %d %d ", k, xtypes[k], xindex[k]) ;
- printimat(ccc[k], 1, 2) ;
+ if (cupt->ignore)
+ continue;
+
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ iclear2D (&ccx, maxeg, 2, 0);
+ for (k = 0; k < nrows; ++k)
+ {
+ a = xtypes[k];
+
+ if (i == -1)
+ {
+ printf ("zzq %d %d %d %d\n", i, k, outnum, ccc[k][0]);
+ }
+
+ if (a < 0)
+ continue;
+ if (a >= maxeg)
+ continue;
+ g = ccc[k][0];
+ if (g < 0)
+ continue;
+ cc = ccx[a];
+ ivvp (cc, cc, ccc[k], 2);
+ }
+
+ if (outnum < 0)
+ {
+ a0 = a1 = 0;
+ for (j = 0; j < numeg; ++j)
+ {
+ a0 += ccx[j][0];
+ a1 += ccx[j][1];
+ }
+ }
+
+ else
+ {
+ a0 = ccx[outnum][0];
+ a1 = ccx[outnum][1];
+ }
+
+ aa = a0 + a1;
+ if (a0 == 0)
+ continue;
+ if (a1 == 0)
+ continue;
+ p = (double) a0 / (double) aa;
+ wt = 1.0 / (p * (1.0 - p));
+ if (outnum == -99)
+ wt = 1.0;
+
+ if (t == 0)
+ {
+ for (k = 0; k < nrows; ++k)
+ {
+ printf ("ww1: %d %d %d ", k, xtypes[k], xindex[k]);
+ printimat (ccc[k], 1, 2);
+ }
+ }
+ for (k = 0; k < numeg; ++k)
+ {
+ a0 = ccx[k][0];
+ a1 = ccx[k][1];
+ aa = a0 + a1;
+ if (t == 0)
+ printf ("zzyy %d %d %d\n", k, a0, a1);
+
+ if (aa < 2)
+ {
+ wt = 0;
+ break;
+ }
+ if (k < numeg)
+ continue;
+ }
+ cupt->weight = wt;
}
- }
- for (k=0; k<numeg ; ++k) {
- a0 = ccx[k][0] ;
- a1 = ccx[k][1] ;
- aa = a0+a1 ;
- if (t==0) printf("zzyy %d %d %d\n", k, a0, a1) ;
-
- if (aa<2) {
- wt = 0 ;
- break ;
- }
- if (k<numeg) continue ;
- }
- cupt -> weight = wt ;
- }
- for (i=0; i<numsnps; ++i) {
- cupt = snpmarkers[i] ;
- if (cupt -> weight <= 0.0) cupt -> ignore = YES ;
- }
-
+ for (i = 0; i < numsnps; ++i)
+ {
+ cupt = snpmarkers[i];
+ if (cupt->weight <= 0.0)
+ cupt->ignore = YES;
+ }
- free2Dint(&ccx, maxeg) ;
- free2Dint(&ccc, nrows) ;
+ free2Dint (&ccx, maxeg);
+ free2Dint (&ccc, nrows);
}
void
-countg(int *rawcol, int **cc, int *xtypes, int n, int ntypes)
-{
- int g, i, c0, c1, k ;
-
- iclear2D(&cc, ntypes, 2, 0) ;
- for (i=0; i<n; i++) {
- g = rawcol[i] ;
- if (g<0) continue ;
- c0 = g ;
- c1 = 2-g ;
- k = xtypes[i] ;
- if (k<0) continue ;
- if (k>ntypes) continue ;
- cc[k][0] += c0 ;
- cc[k][1] += c1 ;
- }
-}
+countg (int *rawcol, int **cc, int *xtypes, int n, int ntypes)
+{
+ int g, i, c0, c1, k;
+
+ iclear2D (&cc, ntypes, 2, 0);
+ for (i = 0; i < n; i++)
+ {
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ c0 = g;
+ c1 = 2 - g;
+ k = xtypes[i];
+ if (k < 0)
+ continue;
+ if (k > ntypes)
+ continue;
+ cc[k][0] += c0;
+ cc[k][1] += c1;
+ }
+}
void
-dohzgjack(double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, int *bcols, int nblocks)
-{
-
- int t1, t2 ;
- int c1[2], c2[2], *cc ;
- int *rawcol, *popall, *pop0, *pop1 ;
- int k, g, i, col, j ;
- double ya, yb, y, jest, jsig, mean ;
- SNP *cupt ;
- double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop ;
- double **btop, **bbot ;
- int bnum ;
-
- ZALLOC(gtop, numeg*numeg, double) ;
- ZALLOC(gbot, numeg*numeg, double) ;
- ZALLOC(wtop, numeg*numeg, double) ;
- ZALLOC(wbot, numeg*numeg, double) ;
- ZALLOC(djack, nblocks, double) ;
- ZALLOC(wjack, nblocks, double) ;
- btop = initarray_2Ddouble(nblocks, numeg*numeg, 0.0) ;
- bbot = initarray_2Ddouble(nblocks, numeg*numeg, 0.0) ;
-
- ZALLOC(rawcol, nrows, int) ;
- ZALLOC(pop0, numeg, int) ;
- ZALLOC(pop1, numeg, int) ;
- ZALLOC(popall, numeg, int) ;
-
- ivclear(bcols, -1, ncols) ;
-
- for (col=0; col<ncols; ++col) {
- ivzero(popall, numeg) ;
- ivzero(pop0, numeg) ;
- ivzero(pop1, numeg) ;
- cupt = xsnplist[col] ;
- bnum = cupt -> tagnumber ;
- bcols[col] = bnum ;
- if (bnum<0) continue ;
- ++wjack[bnum] ;
- top = btop[bnum] ;
- bot = bbot[bnum] ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- if (k<0) continue ;
- if (k>=numeg) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- pop1[k] += g ;
- pop0[k] += 2-g ;
- popall[k] += 2 ; // code needs chamging for X
- }
- for (k=0; k<numeg; k++) {
- ya = pop0[k] ;
- yb = pop1[k] ;
- top[k*numeg+k] += 2*ya*yb ;
- y = ya + yb ;
- bot[k*numeg+k] += y*(y-1.0) ;
- for (j=k+1; j<numeg; j++) {
- ya = pop0[j] ;
- yb = pop1[k] ;
- y = ya + yb ;
- top[k*numeg+j] += ya*yb ;
- ya = pop1[j] ;
- yb = pop0[k] ;
- top[j*numeg+k] = top[k*numeg+j] += ya*yb ;
-
- ya = popall[k] ;
- yb = popall[j] ;
- bot[k*numeg+j] += ya*yb ;
-
- top[j*numeg+k] = top[k*numeg+j] ;
- bot[j*numeg+k] = bot[k*numeg+j] ;
- }
- }
- }
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, numeg*numeg) ;
- vvp(gbot, gbot, bot, numeg*numeg) ;
+dohzgjack (double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
+ int nrows, int ncols, int numeg, int *bcols, int nblocks)
+{
+
+ int t1, t2;
+ int c1[2], c2[2], *cc;
+ int *rawcol, *popall, *pop0, *pop1;
+ int k, g, i, col, j;
+ double ya, yb, y, jest, jsig, mean;
+ SNP *cupt;
+ double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
+ double **btop, **bbot;
+ int bnum;
+
+ ZALLOC(gtop, numeg*numeg, double);
+ ZALLOC(gbot, numeg*numeg, double);
+ ZALLOC(wtop, numeg*numeg, double);
+ ZALLOC(wbot, numeg*numeg, double);
+ ZALLOC(djack, nblocks, double);
+ ZALLOC(wjack, nblocks, double);
+ btop = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
+ bbot = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
+
+ ZALLOC(rawcol, nrows, int);
+ ZALLOC(pop0, numeg, int);
+ ZALLOC(pop1, numeg, int);
+ ZALLOC(popall, numeg, int);
+
+ ivclear (bcols, -1, ncols);
+
+ for (col = 0; col < ncols; ++col)
+ {
+ ivzero (popall, numeg);
+ ivzero (pop0, numeg);
+ ivzero (pop1, numeg);
+ cupt = xsnplist[col];
+ bnum = cupt->tagnumber;
+ bcols[col] = bnum;
+ if (bnum < 0)
+ continue;
+ ++wjack[bnum];
+ top = btop[bnum];
+ bot = bbot[bnum];
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ if (k < 0)
+ continue;
+ if (k >= numeg)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ pop1[k] += g;
+ pop0[k] += 2 - g;
+ popall[k] += 2; // code needs chamging for X
+ }
+ for (k = 0; k < numeg; k++)
+ {
+ ya = pop0[k];
+ yb = pop1[k];
+ top[k * numeg + k] += 2 * ya * yb;
+ y = ya + yb;
+ bot[k * numeg + k] += y * (y - 1.0);
+ for (j = k + 1; j < numeg; j++)
+ {
+ ya = pop0[j];
+ yb = pop1[k];
+ y = ya + yb;
+ top[k * numeg + j] += ya * yb;
+ ya = pop1[j];
+ yb = pop0[k];
+ top[j * numeg + k] = top[k * numeg + j] += ya * yb;
+
+ ya = popall[k];
+ yb = popall[j];
+ bot[k * numeg + j] += ya * yb;
+
+ top[j * numeg + k] = top[k * numeg + j];
+ bot[j * numeg + k] = bot[k * numeg + j];
+ }
+ }
}
-/**
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvp(gtop, gtop, top, numeg*numeg) ;
- vvp(gbot, gbot, bot, numeg*numeg) ;
- }
-*/
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- bot = bbot[k] ;
- vvm(wtop, gtop, top, numeg*numeg) ;
- vvm(wbot, gbot, bot, numeg*numeg) ;
- vsp(wbot, wbot, 1.0e-10, numeg*numeg) ;
- vvd(top, wtop, wbot, numeg*numeg) ; // delete-block estimate
- }
- vsp(gbot, gbot, 1.0e-10, numeg*numeg) ;
- vvd(gtop, gtop, gbot, numeg*numeg) ;
- for (i=0; i<numeg; i++) {
- for (j=i; j<numeg ; j++) {
- for (k=0; k<nblocks; k++) {
- top = btop[k] ;
- djack[k] = top[i*numeg+j] ;
- }
-
- mean = gtop[i*numeg+j] ;
- wjackest(&jest, &jsig, mean, djack, wjack, nblocks) ;
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvp (gtop, gtop, top, numeg * numeg);
+ vvp (gbot, gbot, bot, numeg * numeg);
+ }
+ /**
+ for (k=0; k<nblocks; k++) {
+ top = btop[k] ;
+ bot = bbot[k] ;
+ vvp(gtop, gtop, top, numeg*numeg) ;
+ vvp(gbot, gbot, bot, numeg*numeg) ;
+ }
+ */
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ bot = bbot[k];
+ vvm (wtop, gtop, top, numeg * numeg);
+ vvm (wbot, gbot, bot, numeg * numeg);
+ vsp (wbot, wbot, 1.0e-10, numeg * numeg);
+ vvd (top, wtop, wbot, numeg * numeg); // delete-block estimate
+ }
+ vsp (gbot, gbot, 1.0e-10, numeg * numeg);
+ vvd (gtop, gtop, gbot, numeg * numeg);
+ for (i = 0; i < numeg; i++)
+ {
+ for (j = i; j < numeg; j++)
+ {
+ for (k = 0; k < nblocks; k++)
+ {
+ top = btop[k];
+ djack[k] = top[i * numeg + j];
+ }
+
+ mean = gtop[i * numeg + j];
+ wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
// printf("zz %d %d %12.6f %12.6f\n", i, j, mean, jest) ;
- hest[i*numeg+j] = hest[j*numeg+i] = jest ;
- hsig[i*numeg+j] = hsig[j*numeg+i] = jsig ;
- }
+ hest[i * numeg + j] = hest[j * numeg + i] = jest;
+ hsig[i * numeg + j] = hsig[j * numeg + i] = jsig;
+ }
}
- free(rawcol) ;
- free(pop0) ;
- free(pop1) ;
- free(popall) ;
- free(gtop) ;
- free(gbot) ;
- free(wtop) ;
- free(wbot) ;
- free(djack) ;
- free(wjack) ;
+ free (rawcol);
+ free (pop0);
+ free (pop1);
+ free (popall);
+ free (gtop);
+ free (gbot);
+ free (wtop);
+ free (wbot);
+ free (djack);
+ free (wjack);
- free2D(&btop, nblocks);
- free2D(&bbot, nblocks);
+ free2D (&btop, nblocks);
+ free2D (&bbot, nblocks);
}
-void wjackvest(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g)
+void
+wjackvest (double *vest, double *var, int d, double *mean, double **jmean,
+ double *jwt, int g)
// test for jwt 0
{
- double **jjmean, *jjwt ;
- int i, n ;
+ double **jjmean, *jjwt;
+ int i, n;
- jjmean = initarray_2Ddouble(g, d, 0.0) ;
- ZALLOC(jjwt, g, double) ;
+ jjmean = initarray_2Ddouble (g, d, 0.0);
+ ZALLOC(jjwt, g, double);
- n = 0 ;
+ n = 0;
- for (i=0; i<g ; ++i) {
- if (jwt[i] < 1.0e-6) continue ;
- copyarr(jmean[i], jjmean[n], d) ;
- jjwt[n] = jwt[i] ;
- ++n ;
- }
+ for (i = 0; i < g; ++i)
+ {
+ if (jwt[i] < 1.0e-6)
+ continue;
+ copyarr (jmean[i], jjmean[n], d);
+ jjwt[n] = jwt[i];
+ ++n;
+ }
- wjackvestx(vest, var, d, mean, jjmean, jjwt, n) ;
+ wjackvestx (vest, var, d, mean, jjmean, jjwt, n);
- free2D(&jjmean, g) ;
- free(jjwt) ;
+ free2D (&jjmean, g);
+ free (jjwt);
}
-
static
-void wjackvestx(double *vest, double *var, int d, double *mean, double **jmean, double *jwt, int g)
+void
+wjackvestx (double *vest, double *var, int d, double *mean, double **jmean,
+ double *jwt, int g)
// weighted jackknife see wjack.tex
// mean is natural estimate. jmean[k] mean with block k removed. jwt is weight for block (sample size)
/**
@@ -3023,250 +3382,278 @@ void wjackvestx(double *vest, double *var, int d, double *mean, double **jmean,
Output vest is d long (jackknife estimate)
var is error variance
-*/
-{
-
- double *xtau, *hh ;
- double *jackest, yn, yvar ;
- double *wa ;
- int j, k ;
- double y1, y2 ;
-
- if (g<=1) fatalx("(wjackvest) not enough blocks\n") ;
-
- ZALLOC(hh, g, double) ;
- ZALLOC(xtau, d, double) ;
- ZALLOC(wa, d, double) ;
-
- jackest = vest ;
-
- vzero(var, d*d) ;
- vzero(jackest, d) ;
-
- yn = asum(jwt, g) ;
-
- for (k=0; k<g; ++k) {
- vvm(wa, mean, jmean[k], d) ;
- vvp(jackest, jackest, wa, d) ;
- vst(wa, jmean[k], jwt[k]/yn, d) ;
- vvp(jackest, jackest, wa, d) ;
- }
-// this is equation 2
-
- vclear(hh, yn, g) ;
-
- for (k=0; k<g; ++k) {
-
- if (jwt[k] > 0.0) hh[k] /= jwt[k] ;
- else hh[k] *= 1.0e20 ;
-
- y1 = hh[k] ;
- vst(xtau, mean, y1, d) ;
- --y1 ;
- vst(wa, jmean[k], y1, d) ;
- vvm(xtau, xtau, wa, d) ;
- vvm(xtau, xtau, jackest, d) ;
- y2 = 1.0/sqrt(y1) ;
- vst(wa, xtau, y2, d) ;
- addouter(var, wa, d) ;
- }
-// jwt should be positive
-
-
- vst(var, var, 1.0 / (double) g, d*d) ;
-
- free(hh) ;
- free(xtau) ;
- free(wa) ;
-
-}
-
-int f3yyx(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg, Indiv **indm)
+ */
{
- int *c1, *c2, *c3, *cc ;
- int *rawcol ;
- int k, g, i, a, b, c ;
- int a0, a1, kret ;
- double ya, yb, yaa, ybb, p1, p2, p3, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
- int **ccc, *gg, **ccx ;
- static int ncall = 0 ;
+ double *xtau, *hh;
+ double *jackest, yn, yvar;
+ double *wa;
+ int j, k;
+ double y1, y2;
+ if (g <= 1)
+ fatalx ("(wjackvest) not enough blocks\n");
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ccx = initarray_2Dint(numeg+1, 2, 0) ;
+ ZALLOC(hh, g, double);
+ ZALLOC(xtau, d, double);
+ ZALLOC(wa, d, double);
- vzero(estmat, numeg*numeg*numeg) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indm) ;
-
- for (k=0; k<nrows; ++k) {
- a = xtypes[k] ;
- if (a<0) continue ;
- if (a>=numeg) continue ;
- g = ccc[k][0] ;
- if (g<0) continue ;
- cc = ccx[a] ;
- ivvp(cc, cc, ccc[k], 2) ;
- }
+ jackest = vest;
- kret = 1 ;
+ vzero (var, d * d);
+ vzero (jackest, d);
- for (a=0; a<numeg ; a++) {
- for (b=0; b<numeg ; b++) {
- for (c=0 ; c<numeg ; c++) {
- if (a==b) continue ;
- if (a==c) continue ;
- if (c<b) continue ;
+ yn = asum (jwt, g);
- c1 = ccx[a] ;
- c2 = ccx[b] ;
- c3 = ccx[c] ;
-
- ya = (double) c1[0] ;
- yb = (double) c1[1] ;
- z = ya + yb ;
-
-
- yt = ya+yb ;
- if (yt<=0) {
- kret = -1; break ;
- }
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
-
-
- yaa = (double) c2[0] ;
- ybb = (double) c2[1] ;
- yt = yaa+ybb ;
- if (yt<=0) {
- kret = -1; break ;
- }
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
- zz = yaa + ybb ;
-
- yaa = (double) c3[0] ;
- ybb = (double) c3[1] ;
- yt = yaa+ybb ;
- if (yt<=0) {
- kret = -1; break ;
- }
- p3 = yaa/yt ;
+ for (k = 0; k < g; ++k)
+ {
+ vvm (wa, mean, jmean[k], d);
+ vvp (jackest, jackest, wa, d);
+ vst (wa, jmean[k], jwt[k] / yn, d);
+ vvp (jackest, jackest, wa, d);
+ }
+// this is equation 2
- en = (p1-p2)*(p1-p3) ;
- en -= h1/z ;
+ vclear (hh, yn, g);
+
+ for (k = 0; k < g; ++k)
+ {
+
+ if (jwt[k] > 0.0)
+ hh[k] /= jwt[k];
+ else
+ hh[k] *= 1.0e20;
+
+ y1 = hh[k];
+ vst (xtau, mean, y1, d);
+ --y1;
+ vst (wa, jmean[k], y1, d);
+ vvm (xtau, xtau, wa, d);
+ vvm (xtau, xtau, jackest, d);
+ y2 = 1.0 / sqrt (y1);
+ vst (wa, xtau, y2, d);
+ addouter (var, wa, d);
+ }
+// jwt should be positive
- if (b==c) en -= h2/zz ;
-
- bump3(estmat, a, b, c, numeg, en) ;
- if (b!=c) bump3(estmat, a, c, b, numeg, en) ;
- }
- }
- }
-
+ vst (var, var, 1.0 / (double) g, d * d);
- free2Dint(&ccc, nrows) ;
- free2Dint(&ccx, numeg+1) ;
- return kret ;
+ free (hh);
+ free (xtau);
+ free (wa);
}
-void f3yy(double *estmat, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int numeg)
-{
- int *c1, *c2, *c3, *cc ;
- int *rawcol ;
- int k, g, i, a, b, c ;
- double ya, yb, yaa, ybb, p1, p2, p3, en, ed ;
- double z, zz, h1, h2, yt ;
- double ywt ;
-
- int **ccc, *gg, **ccx ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ccx = initarray_2Dint(numeg, 2, 0) ;
-
- vzero(estmat, numeg*numeg*numeg) ;
-
- ZALLOC(rawcol, nrows, int) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- for (a=0; a<nrows; a++) {
- g = rawcol[a] ;
- ccc[a][0] = g ;
- ccc[a][1] = 2-g ;
+int
+f3yyx (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows,
+ int numeg, Indiv **indm)
+{
+ int *c1, *c2, *c3, *cc;
+ int *rawcol;
+ int k, g, i, a, b, c;
+ int a0, a1, kret;
+ double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+
+ int **ccc, *gg, **ccx;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ccx = initarray_2Dint (numeg + 1, 2, 0);
+
+ vzero (estmat, numeg * numeg * numeg);
+
+ getrawcolx (ccc, cupt, xindex, nrows, indm);
+
+ for (k = 0; k < nrows; ++k)
+ {
+ a = xtypes[k];
+ if (a < 0)
+ continue;
+ if (a >= numeg)
+ continue;
+ g = ccc[k][0];
+ if (g < 0)
+ continue;
+ cc = ccx[a];
+ ivvp (cc, cc, ccc[k], 2);
}
- free(rawcol) ;
- for (k=0; k<nrows; ++k) {
- a = xtypes[k] ;
- if (a<0) continue ;
- if (a>=numeg) continue ;
- g = ccc[k][0] ;
- if (g<0) continue ;
- cc = ccx[a] ;
- ivvp(cc, cc, ccc[k], 2) ;
+ kret = 1;
+
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = 0; b < numeg; b++)
+ {
+ for (c = 0; c < numeg; c++)
+ {
+ if (a == b)
+ continue;
+ if (a == c)
+ continue;
+ if (c < b)
+ continue;
+
+ c1 = ccx[a];
+ c2 = ccx[b];
+ c3 = ccx[c];
+
+ ya = (double) c1[0];
+ yb = (double) c1[1];
+ z = ya + yb;
+
+ yt = ya + yb;
+ if (yt <= 0)
+ {
+ kret = -1;
+ break;
+ }
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
+
+ yaa = (double) c2[0];
+ ybb = (double) c2[1];
+ yt = yaa + ybb;
+ if (yt <= 0)
+ {
+ kret = -1;
+ break;
+ }
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+ zz = yaa + ybb;
+
+ yaa = (double) c3[0];
+ ybb = (double) c3[1];
+ yt = yaa + ybb;
+ if (yt <= 0)
+ {
+ kret = -1;
+ break;
+ }
+ p3 = yaa / yt;
+
+ en = (p1 - p2) * (p1 - p3);
+ en -= h1 / z;
+
+ if (b == c)
+ en -= h2 / zz;
+
+ bump3 (estmat, a, b, c, numeg, en);
+ if (b != c)
+ bump3 (estmat, a, c, b, numeg, en);
+ }
+ }
}
- for (a=0; a<numeg ; a++) {
- for (b=0; b<numeg ; b++) {
- for (c=0 ; c<numeg ; c++) {
- if (a==b) continue ;
- if (a==c) continue ;
- if (c<b) continue ;
-
- c1 = ccx[a] ;
- c2 = ccx[b] ;
- c3 = ccx[c] ;
-
- ya = (double) c1[0] ;
- yb = (double) c1[1] ;
- z = ya + yb ;
-
-
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
-
- yaa = (double) c2[0] ;
- ybb = (double) c2[1] ;
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
- zz = yaa + ybb ;
+ free2Dint (&ccc, nrows);
+ free2Dint (&ccx, numeg + 1);
+ return kret;
- yaa = (double) c3[0] ;
- ybb = (double) c3[1] ;
- yt = yaa+ybb ;
- p3 = yaa/yt ;
+}
- en = (p1-p2)*(p1-p3) ;
- en -= h1/z ;
+void
+f3yy (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows, int numeg)
+{
+ int *c1, *c2, *c3, *cc;
+ int *rawcol;
+ int k, g, i, a, b, c;
+ double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
+ double z, zz, h1, h2, yt;
+ double ywt;
+
+ int **ccc, *gg, **ccx;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ccx = initarray_2Dint (numeg, 2, 0);
+
+ vzero (estmat, numeg * numeg * numeg);
+
+ ZALLOC(rawcol, nrows, int);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ for (a = 0; a < nrows; a++)
+ {
+ g = rawcol[a];
+ ccc[a][0] = g;
+ ccc[a][1] = 2 - g;
+ }
+ free (rawcol);
+
+ for (k = 0; k < nrows; ++k)
+ {
+ a = xtypes[k];
+ if (a < 0)
+ continue;
+ if (a >= numeg)
+ continue;
+ g = ccc[k][0];
+ if (g < 0)
+ continue;
+ cc = ccx[a];
+ ivvp (cc, cc, ccc[k], 2);
+ }
- if (b==c) en -= h2/zz ;
-
- bump3(estmat, a, b, c, numeg, en) ;
- if (b!=c) bump3(estmat, a, c, b, numeg, en) ;
- }
- }
- }
-
+ for (a = 0; a < numeg; a++)
+ {
+ for (b = 0; b < numeg; b++)
+ {
+ for (c = 0; c < numeg; c++)
+ {
+ if (a == b)
+ continue;
+ if (a == c)
+ continue;
+ if (c < b)
+ continue;
+
+ c1 = ccx[a];
+ c2 = ccx[b];
+ c3 = ccx[c];
+
+ ya = (double) c1[0];
+ yb = (double) c1[1];
+ z = ya + yb;
+
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
+
+ yaa = (double) c2[0];
+ ybb = (double) c2[1];
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
+ zz = yaa + ybb;
+
+ yaa = (double) c3[0];
+ ybb = (double) c3[1];
+ yt = yaa + ybb;
+ p3 = yaa / yt;
+
+ en = (p1 - p2) * (p1 - p3);
+ en -= h1 / z;
+
+ if (b == c)
+ en -= h2 / zz;
+
+ bump3 (estmat, a, b, c, numeg, en);
+ if (b != c)
+ bump3 (estmat, a, c, b, numeg, en);
+ }
+ }
+ }
- free2Dint(&ccc, nrows) ;
- free2Dint(&ccx, numeg) ;
+ free2Dint (&ccc, nrows);
+ free2Dint (&ccx, numeg);
}
-
-double estmix(double *z, double *f3, int n)
+double
+estmix (double *z, double *f3, int n)
/**
We minimize
@@ -3278,109 +3665,122 @@ double estmix(double *z, double *f3, int n)
where X are f_3 or f_2 coefficients.
We solve this by setting lambda = 1 and then normalizing the answer to sum
to 1.
-*/
+ */
{
- int a, b ;
- int d = n-1 ;
- double *co, *rhs, y, *ww, *w1 ;
+ int a, b;
+ int d = n - 1;
+ double *co, *rhs, y, *ww, *w1;
- ZALLOC(co, d*d, double) ;
- ZALLOC(ww, d*d, double) ;
- ZALLOC(rhs, d, double) ;
- ZALLOC(w1, d, double) ;
+ ZALLOC(co, d*d, double);
+ ZALLOC(ww, d*d, double);
+ ZALLOC(rhs, d, double);
+ ZALLOC(w1, d, double);
- vclear(rhs, 1.0, d) ;
+ vclear (rhs, 1.0, d);
- for (a=0; a<d; a++) {
- for (b=a; b<d; b++) {
+ for (a = 0; a < d; a++)
+ {
+ for (b = a; b < d; b++)
+ {
- y = dump3(f3, 0, a+1, b+1, n) ;
+ y = dump3 (f3, 0, a + 1, b + 1, n);
// works if a = b as dof3 fixed up
- co[a*d+b] = co[b*d+a] = y ;
+ co[a * d + b] = co[b * d + a] = y;
- }
- }
- vclear(w1, 1.0, d) ;
- mulmat(rhs, co, w1, d, d, 1) ;
- mulmat(ww, co, co, d, d, d) ;
+ }
+ }
+ vclear (w1, 1.0, d);
+ mulmat (rhs, co, w1, d, d, 1);
+ mulmat (ww, co, co, d, d, d);
- solvit(ww, rhs, d, z) ;
+ solvit (ww, rhs, d, z);
- y = asum(z, d) ;
- if (y==0.0) fatalx("z is zero!\n") ;
- vst(z, z, 1.0/y, d) ;
+ y = asum (z, d);
+ if (y == 0.0)
+ fatalx ("z is zero!\n");
+ vst (z, z, 1.0 / y, d);
- mulmat(rhs, co, z, d, d, 1) ;
- y = vdot(z, rhs, d) ;
+ mulmat (rhs, co, z, d, d, 1);
+ y = vdot (z, rhs, d);
- free(co) ;
- free(rhs) ;
- free(ww) ;
- free(w1) ;
+ free (co);
+ free (rhs);
+ free (ww);
+ free (w1);
- return y ;
+ return y;
}
-double ff3val(double *ff3, int a, int b, int c, int n)
+double
+ff3val (double *ff3, int a, int b, int c, int n)
{
- double y ;
+ double y;
- y = dump3(ff3, 0, a, a, n) ;
- y += dump3(ff3, 0, b, c, n) ;
- y -= dump3(ff3, 0, b, a, n) ;
- y -= dump3(ff3, 0, c, a, n) ;
- return y ;
+ y = dump3 (ff3, 0, a, a, n);
+ y += dump3 (ff3, 0, b, c, n);
+ y -= dump3 (ff3, 0, b, a, n);
+ y -= dump3 (ff3, 0, c, a, n);
+ return y;
}
-void setinbreed(int val)
+void
+setinbreed (int val)
{
- inbreed = val ;
+ inbreed = val;
}
void
-calchetinbreed(int *c1, double *phet, double *phetin)
+calchetinbreed (int *c1, double *phet, double *phetin)
{
- double s, t, a, b, h1, h2, ex, en, ed ;
- double x0, x1, x2, y0, y1, y2 ;
+ double s, t, a, b, h1, h2, ex, en, ed;
+ double x0, x1, x2, y0, y1, y2;
- *phet = *phetin = -1.0 ;
- s = intsum(c1, 3) ;
- if (s<1.5) return ;
- x0 = c1[0] ; x1=c1[1] ; x2=c1[2] ;
- h1 = x0*x2 + (x0+x2)*x1/2 + x1*(x1-1)/4 ;
- h1 /= (double) (s*(s-1)) ;
- *phet = 2*h1 ;
- *phetin = x1 / (double) s ; //naive estimate, unbiased
+ *phet = *phetin = -1.0;
+ s = intsum (c1, 3);
+ if (s < 1.5)
+ return;
+ x0 = c1[0];
+ x1 = c1[1];
+ x2 = c1[2];
+ h1 = x0 * x2 + (x0 + x2) * x1 / 2 + x1 * (x1 - 1) / 4;
+ h1 /= (double) (s * (s - 1));
+ *phet = 2 * h1;
+ *phetin = x1 / (double) s; //naive estimate, unbiased
}
void
-calcndinbreed(int *c1, int *c2, double *pen, double *ped)
-{
-
- double s, t, a, b, h1, h2, ex, en, ed ;
- double x0, x1, x2, y0, y1, y2 ;
-
- *pen = *ped = -1.0 ;
- s = intsum(c1, 3) ;
- t = intsum(c2, 3) ;
- if (s<1.5) return ;
- if (t<1.5) return ;
- x0 = c1[0] ; x1=c1[1] ; x2=c1[2] ;
- y0 = c2[0] ; y1=c2[1] ; y2=c2[2] ;
- a = (x1 + 2*x2) / (2*s) ;
- b = (y1 + 2*y2) / (2*t) ;
- ex = (a-b)*(a-b) ;
- ex += x1/(4*s*s) ;
- ex += y1/(4*t*t) ;
- h1 = x0*x2 + (x0+x2)*x1/2 + x1*(x1-1)/4 ;
- h2 = y0*y2 + (y0+y2)*y1/2 + y1*(y1-1)/4 ;
- h1 /= (double) s*(s-1) ;
- h2 /= (double) t*(t-1) ;
- en = ex - (h1/s + h2/t) ;
- ed = en + h1 + h2 ;
- *pen = en ;
- *ped = ed ;
+calcndinbreed (int *c1, int *c2, double *pen, double *ped)
+{
+
+ double s, t, a, b, h1, h2, ex, en, ed;
+ double x0, x1, x2, y0, y1, y2;
+
+ *pen = *ped = -1.0;
+ s = intsum (c1, 3);
+ t = intsum (c2, 3);
+ if (s < 1.5)
+ return;
+ if (t < 1.5)
+ return;
+ x0 = c1[0];
+ x1 = c1[1];
+ x2 = c1[2];
+ y0 = c2[0];
+ y1 = c2[1];
+ y2 = c2[2];
+ a = (x1 + 2 * x2) / (2 * s);
+ b = (y1 + 2 * y2) / (2 * t);
+ ex = (a - b) * (a - b);
+ ex += x1 / (4 * s * s);
+ ex += y1 / (4 * t * t);
+ h1 = x0 * x2 + (x0 + x2) * x1 / 2 + x1 * (x1 - 1) / 4;
+ h2 = y0 * y2 + (y0 + y2) * y1 / 2 + y1 * (y1 - 1) / 4;
+ h1 /= (double) s * (s - 1);
+ h2 /= (double) t * (t - 1);
+ en = ex - (h1 / s + h2 / t);
+ ed = en + h1 + h2;
+ *pen = en;
+ *ped = ed;
}
-
diff --git a/src/qq b/src/qq
deleted file mode 100644
index e0f09ec..0000000
--- a/src/qq
+++ /dev/null
@@ -1,2 +0,0 @@
- printf("##bug: \n") ; printmat(evecs, 1, 20) ;
-
diff --git a/src/qqq.c b/src/qqq.c
index b9a6fcd..6268d35 100644
--- a/src/qqq.c
+++ b/src/qqq.c
@@ -29,93 +29,93 @@
Some improvements and elimination of FORTRAN code by Chris Chang (BGI)
Code added to support grm output + improved ld rregression by Alexander Gusev
-*/
+ */
#define WVERSION "12000"
/**
-Simple eigenvector analysis
-Options to look at groups (simple ANOVA)
-Weights allowed for individuals
-missing mode
-dotpops added
-recompiled with new twtail. Output form at changed
-Cleaned up twestxx
-fancynorm mode (divide by sqrt(p*(1-p))
-poplistname supported. Eigenanalysis just on individuals in population
-But all individuals figure in eigenvector output
-New way of computing effective marker size (twl2mode)
-popdifference implemented
-ldregression ldlimit (genetic distance in Morgans)
-nostatslim added
-dotpop has new format if many groups
-uses new I/O
-Supports packmode
-Alkes style outlier removal added
-Only half XTX computed
-xdata (huge array) removed
+ Simple eigenvector analysis
+ Options to look at groups (simple ANOVA)
+ Weights allowed for individuals
+ missing mode
+ dotpops added
+ recompiled with new twtail. Output form at changed
+ Cleaned up twestxx
+ fancynorm mode (divide by sqrt(p*(1-p))
+ poplistname supported. Eigenanalysis just on individuals in population
+ But all individuals figure in eigenvector output
+ New way of computing effective marker size (twl2mode)
+ popdifference implemented
+ ldregression ldlimit (genetic distance in Morgans)
+ nostatslim added
+ dotpop has new format if many groups
+ uses new I/O
+ Supports packmode
+ Alkes style outlier removal added
+ Only half XTX computed
+ xdata (huge array) removed
-fst calculation added
-popsizelimit added
-divergence added (not useful?)
+ fst calculation added
+ popsizelimit added
+ divergence added (not useful?)
-SNPs discarded if no data.
-Phylipfile now supported
+ SNPs discarded if no data.
+ Phylipfile now supported
-Preparations for parallelization made
-Various fixups for EIGENSTRAT and altnormstyle
+ Preparations for parallelization made
+ Various fixups for EIGENSTRAT and altnormstyle
-output capability added (like convertf)
+ output capability added (like convertf)
-bug fixed (a last iteration needed for outlier removal)
-bug fixed (numindivs unlimited)
-output files fixed up (NULL OK)
+ bug fixed (a last iteration needed for outlier removal)
+ bug fixed (numindivs unlimited)
+ output files fixed up (NULL OK)
-Many Alkes style options added
-Support for outliername added (outlier info)
-familyname added (ped files)
+ Many Alkes style options added
+ Support for outliername added (outlier info)
+ familyname added (ped files)
-bugfix: jackrat dies (outlier removes all of population)
-bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
+ bugfix: jackrat dies (outlier removes all of population)
+ bugfix: See ~ap92/REICH/FALL06/EIGENSOFTCODE/bugfix bugs 1, 3 fixed
-nrows, ncols output added
-nrows, ncols set each outlier iteration
-indivs with no data removed
+ nrows, ncols output added
+ nrows, ncols set each outlier iteration
+ indivs with no data removed
-writesnpeig added
+ writesnpeig added
-bugfix: popsize of 1 no anova done
-minallelecnt added
-chrom: added
-latest greatest handling of chromosome number added.
-bad bugfix: numvalidgtypes
+ bugfix: popsize of 1 no anova done
+ minallelecnt added
+ chrom: added
+ latest greatest handling of chromosome number added.
+ bad bugfix: numvalidgtypes
-checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
-pubmean added
+ checksizemode added. Bug fix to version 7520 (> 2B genotypes fixed)
+ pubmean added
-fst on X
-fst std errors now fixed
+ fst on X
+ fst std errors now fixed
-bad bug fixed (outfiles changed indivmarkers) ...
+ bad bug fixed (outfiles changed indivmarkers) ...
-fstdetailsname added
-fsthiprecision added
-bug fixed (getrawcolx)
+ fstdetailsname added
+ fsthiprecision added
+ bug fixed (getrawcolx)
-bad bug fix. xtypes not allocated correctly
+ bad bug fix. xtypes not allocated correctly
-version compatible with Mac
-XTX.dbg commented out
+ version compatible with Mac
+ XTX.dbg commented out
-outliermode added
+ outliermode added
-regmode added
-maxpops parametric. Use easymode if large
+ regmode added
+ maxpops parametric. Use easymode if large
-id2pops added
+ id2pops added
-Threading added Chris Chang)
-fastmode (Kevin Galinski)
-*/
+ Threading added Chris Chang)
+ fastmode (Kevin Galinski)
+ */
#if _WIN32
// just in case we try a Windows port in the future
@@ -138,217 +138,281 @@ fastmode (Kevin Galinski)
#define MAXSTR 512
#define MAXPOPS 1000
-char *parname = NULL ;
-char *twxtabname = NULL ;
-char *trashdir = "/var/tmp" ;
-int qtmode = NO ;
+char *parname = NULL;
+char *twxtabname = NULL;
+char *trashdir = "/var/tmp";
+int qtmode = NO;
Indiv **indivmarkers;
-SNP **snpmarkers ;
-
-int numsnps, numindivs ;
-int numeigs = 10 ; /// default
-int markerscore = NO ;
-int maxpops = 100 ;
-int seed = 0 ;
-int chisqmode = NO ; // approx p-value better to use F-stat
-int missingmode = NO ;
-int shrinkmode = NO ;
-int dotpopsmode = YES ;
-int noxdata = YES ; /* default as pop structure dubious if Males and females */
-int fstonly = NO ;
-int pcorrmode = NO ;
-int pcpopsonly = YES ;
-int nostatslim = 10 ;
-int znval = -1 ;
-int popsizelimit = -1 ;
-int altnormstyle = YES ; // affects subtle details in normalization formula
-int minallelecnt = 1 ;
-int maxmissing = 9999999 ;
-int lopos = -999999999, hipos = 999999999 ; // use with xchrom
-
-int packout = -1 ;
-extern enum outputmodetype outputmode ;
-extern int checksizemode ;
-extern int packmode ;
-extern int numchrom ;
-extern int fancynorm ;
-extern int verbose ;
-int ogmode = NO ;
-int fsthiprec = NO ;
-int inbreed = NO ; // for fst
-int easymode = NO ;
-int fastmode = NO ;
-int regmode = NO ;
-
-int numoutliter = 5, numoutleigs = 10, outliermode = 0 ;
-double outlthresh = 6.0 ;
-OUTLINFO **outinfo ;
-char *outinfoname = NULL ;
-char *fstdetailsname = NULL ;
-
-
-double plo = .001 ;
-double phi = .999 ;
-double pvhit = .001 ;
-double pvjack = 1.0e-6 ;
-double *chitot ;
-int *xpopsize ;
-
-char *genotypename = NULL ;
-char *snpname = NULL ;
-char *indivname = NULL ;
-char *badsnpname = NULL ;
-char *deletesnpoutname = NULL ;
-char *poplistname = NULL ;
-char *xregionname = NULL ; /* physical positions of SNPs to exclude */
-char *outliername = NULL ;
-char *phylipname = NULL ;
-char *snpeigname = NULL ;
-
-char *indoutfilename = NULL ;
-char *snpoutfilename = NULL ;
-char *genooutfilename = NULL ;
-char *omode = "packedancestrymap" ;
-char *grmoutname = NULL ;
-int grmbinary = NO ;
-double blgsize = 0.05 ; // block size in Morgans */
-char *id2pops = NULL ;
-
-double r2thresh = -1.0 ;
-double r2genlim = 0.01 ; // Morgans
-double r2physlim = 5.0e6 ;
-int killr2 = NO ;
-int pubmean = YES ; // change default
+SNP **snpmarkers;
+
+int numsnps, numindivs;
+int numeigs = 10; /// default
+int markerscore = NO;
+int maxpops = 100;
+int seed = 0;
+int chisqmode = NO; // approx p-value better to use F-stat
+int missingmode = NO;
+int shrinkmode = NO;
+int dotpopsmode = YES;
+int noxdata = YES; /* default as pop structure dubious if Males and females */
+int fstonly = NO;
+int pcorrmode = NO;
+int pcpopsonly = YES;
+int nostatslim = 10;
+int znval = -1;
+int popsizelimit = -1;
+int altnormstyle = YES; // affects subtle details in normalization formula
+int minallelecnt = 1;
+int maxmissing = 9999999;
+int lopos = -999999999, hipos = 999999999; // use with xchrom
+
+int packout = -1;
+extern enum outputmodetype outputmode;
+extern int checksizemode;
+extern int packmode;
+extern int numchrom;
+extern int fancynorm;
+extern int verbose;
+int ogmode = NO;
+int fsthiprec = NO;
+int inbreed = NO; // for fst
+int easymode = NO;
+int fastmode = NO;
+int regmode = NO;
+
+int numoutliter = 5, numoutleigs = 10, outliermode = 0;
+double outlthresh = 6.0;
+OUTLINFO **outinfo;
+char *outinfoname = NULL;
+char *fstdetailsname = NULL;
+
+double plo = .001;
+double phi = .999;
+double pvhit = .001;
+double pvjack = 1.0e-6;
+double *chitot;
+int *xpopsize;
+
+char *genotypename = NULL;
+char *snpname = NULL;
+char *indivname = NULL;
+char *badsnpname = NULL;
+char *deletesnpoutname = NULL;
+char *poplistname = NULL;
+char *xregionname = NULL; /* physical positions of SNPs to exclude */
+char *outliername = NULL;
+char *phylipname = NULL;
+char *snpeigname = NULL;
+
+char *indoutfilename = NULL;
+char *snpoutfilename = NULL;
+char *genooutfilename = NULL;
+char *omode = "packedancestrymap";
+char *grmoutname = NULL;
+int grmbinary = NO;
+double blgsize = 0.05; // block size in Morgans */
+char *id2pops = NULL;
+
+double r2thresh = -1.0;
+double r2genlim = 0.01; // Morgans
+double r2physlim = 5.0e6;
+int killr2 = NO;
+int pubmean = YES; // change default
double nhwfilter = -1.0;
int thread_ct_config = 0;
-int randomfillin = NO ;
-int usepopsformissing = NO ; // if YES popmean is used for missing. Overall mean if all missing for pop
+int randomfillin = NO;
+int usepopsformissing = NO; // if YES popmean is used for missing. Overall mean if all missing for pop
-int xchrom = -1 ;
+int xchrom = -1;
// list of outliers
-int ldregress = 0 ;
-double ldlimit = 9999.0 ; /* default is infinity */
-double ldr2lo = 0.01 ;
-double ldr2hi = 0.95 ;
-int ldposlimit = 1000*1000*1000 ;
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi) ;
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum) ;
-
-
-char *outputname = NULL ;
-char *outputvname = NULL ;
-char *weightname = NULL ;
-FILE *ofile, *ovfile ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double twnorm(double lam, double m, double n) ;
-double rhoinv(double x, double gam) ;
-
-void readcommands(int argc, char **argv) ;
-int loadindx(Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs) ;
-void loadxdataind(double *xrow, SNP **snplist, int ind, int ncols) ;
-void fixxrow(double *xrow, double *xmean, double *xfancy, int len) ;
-void dofancy(double *cc, int n, double *fancy) ;
-int fvadjust(double *rr, int n, double *pmean, double *fancy) ;
-void getcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void getcolxf(double *xcol, SNP *cupt, int *xindex,
- int nrows, int col, double *xmean, double *xfancy) ;
-int getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes,
- int nrows, int col, double *xmean, double *xfancy, int *n0, int *n1) ;
-int getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex,
- int nrows, int col, double* xmean, double* xfancy,
- int* n0, int* n1);
-void getcolxz_binary2(int* rawcol, uintptr_t* binary_cols,
- uintptr_t* binary_mmask, uint32_t xblock,
- uint32_t nrows);
-
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-
-void putcol(double *cc, double *xdata, int col, int nrows, int ncols) ;
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len) ;
-double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) ;
-double yll(double x1, double x2, double xlen) ;
-void calcmean(double *wmean, double *vec, int len, int *xtypes, int numeg) ;
-double anova1(double *vec, int len, int *xtypes, int numeg) ;
-double anova(double *vec, int len, int *xtypes, int numeg) ;
-void publishit(char *sss, int df, double chi) ;
-
-void setmiss(SNP **snpm, int numsnps) ;
-void setfvecs(double *fvecs, double *evecs, int nrows, int numeigs) ;
-void dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows) ;
-void printxcorr(double *X, int nrows, Indiv **indxx) ;
-
-void fixrho(double *a, int n) ;
-void printdiag(double *a, int n) ;
+int ldregress = 0;
+double ldlimit = 9999.0; /* default is infinity */
+double ldr2lo = 0.01;
+double ldr2hi = 0.95;
+int ldposlimit = 1000 * 1000 * 1000;
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi);
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum);
+
+char *outputname = NULL;
+char *outputvname = NULL;
+char *weightname = NULL;
+FILE *ofile, *ovfile;
+
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+twnorm (double lam, double m, double n);
+double
+rhoinv (double x, double gam);
+
+void
+readcommands (int argc, char **argv);
+int
+loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs);
+void
+loadxdataind (double *xrow, SNP **snplist, int ind, int ncols);
+void
+fixxrow (double *xrow, double *xmean, double *xfancy, int len);
+void
+dofancy (double *cc, int n, double *fancy);
+int
+fvadjust (double *rr, int n, double *pmean, double *fancy);
+void
+getcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy);
+int
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1);
+int
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1);
+void
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows);
+
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+
+void
+putcol (double *cc, double *xdata, int col, int nrows, int ncols);
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len);
+double
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len);
+double
+yll (double x1, double x2, double xlen);
+void
+calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg);
+double
+anova1 (double *vec, int len, int *xtypes, int numeg);
+double
+anova (double *vec, int len, int *xtypes, int numeg);
+void
+publishit (char *sss, int df, double chi);
+
+void
+setmiss (SNP **snpm, int numsnps);
+void
+setfvecs (double *fvecs, double *evecs, int nrows, int numeigs);
+void
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows);
+void
+printxcorr (double *X, int nrows, Indiv **indxx);
+
+void
+fixrho (double *a, int n);
+void
+printdiag (double *a, int n);
int
-ridoutlier(double *evecs, int n, int neigs,
- double thresh, int *badlist, OUTLINFO **outinfo) ;
+ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
+ OUTLINFO **outinfo);
-void addoutersym(double *X, double *v, int n) ;
-void symit(double *X, int n) ;
+void
+addoutersym (double *X, double *v, int n);
+void
+symit (double *X, int n);
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2) ;
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2);
-void jackrat(double *xmean, double *xsd, double *top, double *bot, int len) ;
-void domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf);
-void domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int marker_ct, uint32_t indiv_ct);
-void writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols) ;
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm) ;
-void fixwt(SNP **snpm, int nsnp, double val) ;
-void sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex) ;
-void dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname) ;
-void dofast(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int numeigs, FILE *ofile) ;
+void
+jackrat (double *xmean, double *xsd, double *top, double *bot, int len);
+void
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf);
+void
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int marker_ct,
+ uint32_t indiv_ct);
+void
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols);
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm);
+void
+fixwt (SNP **snpm, int nsnp, double val);
+void
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex);
+void
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname);
+void
+dofast (SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs,
+ int numeigs, FILE *ofile);
uint32_t
-triangle_divide(int64_t cur_prod, int32_t modif)
+triangle_divide (int64_t cur_prod, int32_t modif)
{
// return smallest integer vv for which (vv * (vv + modif)) is no smaller
// than cur_prod, and neither term in the product is negative. (Note the
// lack of a divide by two; cur_prod should also be double its "true" value
// as a result.)
int64_t vv;
- if (cur_prod == 0) {
- if (modif < 0) {
- return -modif;
- } else {
- return 0;
+ if (cur_prod == 0)
+ {
+ if (modif < 0)
+ {
+ return -modif;
+ }
+ else
+ {
+ return 0;
+ }
+ }
+ vv = (int64_t) sqrt ((double) cur_prod);
+ while ((vv - 1) * (vv + modif - 1) >= cur_prod)
+ {
+ vv--;
+ }
+ while (vv * (vv + modif) < cur_prod)
+ {
+ vv++;
}
- }
- vv = (int64_t)sqrt((double)cur_prod);
- while ((vv - 1) * (vv + modif - 1) >= cur_prod) {
- vv--;
- }
- while (vv * (vv + modif) < cur_prod) {
- vv++;
- }
return vv;
}
void
-parallel_bounds(uint32_t ct, int32_t start, uint32_t parallel_idx, uint32_t parallel_tot, int32_t* bound_start_ptr, int32_t* bound_end_ptr)
+parallel_bounds (uint32_t ct, int32_t start, uint32_t parallel_idx,
+ uint32_t parallel_tot, int32_t* bound_start_ptr,
+ int32_t* bound_end_ptr)
{
int32_t modif = 1 - start * 2;
- int64_t ct_tot = ((int64_t)ct) * (ct + modif);
- *bound_start_ptr = triangle_divide((ct_tot * parallel_idx) / parallel_tot, modif);
- *bound_end_ptr = triangle_divide((ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
+ int64_t ct_tot = ((int64_t) ct) * (ct + modif);
+ *bound_start_ptr = triangle_divide ((ct_tot * parallel_idx) / parallel_tot,
+ modif);
+ *bound_end_ptr = triangle_divide (
+ (ct_tot * (parallel_idx + 1)) / parallel_tot, modif);
}
// set align to 1 for no alignment
void
-triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start, uint32_t align)
+triangle_fill (uint32_t* target_arr, uint32_t ct, uint32_t pieces,
+ uint32_t parallel_idx, uint32_t parallel_tot, uint32_t start,
+ uint32_t align)
{
int32_t modif = 1 - start * 2;
uint32_t cur_piece = 1;
@@ -358,31 +422,34 @@ triangle_fill(uint32_t* target_arr, uint32_t ct, uint32_t pieces, uint32_t paral
int32_t ubound;
uint32_t uii;
uint32_t align_m1;
- parallel_bounds(ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
+ parallel_bounds (ct, start, parallel_idx, parallel_tot, &lbound, &ubound);
// x(x+1)/2 is divisible by y iff (x % (2y)) is 0 or (2y - 1).
align *= 2;
align_m1 = align - 1;
target_arr[0] = lbound;
target_arr[pieces] = ubound;
- cur_prod = ((int64_t)lbound) * (lbound + modif);
- ct_tr = (((int64_t)ubound) * (ubound + modif) - cur_prod) / pieces;
- while (cur_piece < pieces) {
- cur_prod += ct_tr;
- lbound = triangle_divide(cur_prod, modif);
- uii = (lbound - ((int32_t)start)) & align_m1;
- if ((uii) && (uii != align_m1)) {
- lbound = start + ((lbound - ((int32_t)start)) | align_m1);
- }
- // lack of this check caused a nasty bug earlier
- if (((uint32_t)lbound) > ct) {
- lbound = ct;
- }
- target_arr[cur_piece++] = lbound;
- }
+ cur_prod = ((int64_t) lbound) * (lbound + modif);
+ ct_tr = (((int64_t) ubound) * (ubound + modif) - cur_prod) / pieces;
+ while (cur_piece < pieces)
+ {
+ cur_prod += ct_tr;
+ lbound = triangle_divide (cur_prod, modif);
+ uii = (lbound - ((int32_t) start)) & align_m1;
+ if ((uii) && (uii != align_m1))
+ {
+ lbound = start + ((lbound - ((int32_t) start)) | align_m1);
+ }
+ // lack of this check caused a nasty bug earlier
+ if (((uint32_t) lbound) > ct)
+ {
+ lbound = ct;
+ }
+ target_arr[cur_piece++] = lbound;
+ }
}
void
-symit2(double* XTX, uintptr_t nrows)
+symit2 (double* XTX, uintptr_t nrows)
{
// unpacks LOWER-triangle-only symmetric matrix representation into regular
// square matrix.
@@ -390,39 +457,48 @@ symit2(double* XTX, uintptr_t nrows)
uintptr_t col_idx;
double* read_col;
double* write_ptr;
- if (nrows < 3) {
- if (nrows < 2) {
+ if (nrows < 3)
+ {
+ if (nrows < 2)
+ {
+ return;
+ }
+ // special case, need to avoid overlapping memcpy
+ XTX[3] = XTX[2];
+ XTX[2] = XTX[1];
return;
}
- // special case, need to avoid overlapping memcpy
- XTX[3] = XTX[2];
- XTX[2] = XTX[1];
- return;
- }
- for (row_idx = nrows - 1; row_idx; row_idx--) {
- memcpy(&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]), (row_idx + 1) * sizeof(double));
- }
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- read_col = &(XTX[row_idx]);
- write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
- for (col_idx = row_idx + 1; col_idx < nrows; col_idx++) {
- *write_ptr++ = read_col[col_idx * nrows];
+ for (row_idx = nrows - 1; row_idx; row_idx--)
+ {
+ memcpy (&(XTX[row_idx * nrows]), &(XTX[(row_idx * (row_idx + 1)) / 2]),
+ (row_idx + 1) * sizeof(double));
+ }
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ read_col = &(XTX[row_idx]);
+ write_ptr = &(XTX[row_idx * nrows + row_idx + 1]);
+ for (col_idx = row_idx + 1; col_idx < nrows; col_idx++)
+ {
+ *write_ptr++ = read_col[col_idx * nrows];
+ }
}
- }
}
void
-copy_transposed(double* orig_matrix, uintptr_t orig_row_ct, uintptr_t orig_col_ct, double* transposed_matrix)
+copy_transposed (double* orig_matrix, uintptr_t orig_row_ct,
+ uintptr_t orig_col_ct, double* transposed_matrix)
{
uintptr_t new_row_idx;
uintptr_t new_col_idx;
double* orig_col_ptr;
- for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++) {
- orig_col_ptr = &(orig_matrix[new_row_idx]);
- for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++) {
- *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ for (new_row_idx = 0; new_row_idx < orig_col_ct; new_row_idx++)
+ {
+ orig_col_ptr = &(orig_matrix[new_row_idx]);
+ for (new_col_idx = 0; new_col_idx < orig_row_ct; new_col_idx++)
+ {
+ *transposed_matrix++ = orig_col_ptr[new_col_idx * orig_col_ct];
+ }
}
- }
}
// make these file scope so multithreading works
@@ -436,1952 +512,2250 @@ static double* g_weights;
static uintptr_t* g_binary_cols;
static uintptr_t* g_binary_mmask;
-int main(int argc, char **argv)
+int
+main (int argc, char **argv)
{
- char sss[MAXSTR] ;
- char **eglist ;
- int numeg ;
- int i, j, k, k1, k2, pos;
- int *vv ;
- SNP *cupt ;
- Indiv *indx ;
- double y1 = 0, y2, y2l, y, y3 ;
-
- int n0, n1, nkill ;
-
- int nindiv = 0 ;
- double ychi, tail, tw ;
- int nignore, numrisks = 1 ;
- double *xrow, *xpt ;
- SNP **xsnplist ;
- Indiv **xindlist ;
- int *xindex, *xtypes = NULL ;
- int nrows, ncols, m, nused ;
- double *XTX, *cc, *evecs, *ww ;
+ char sss[MAXSTR];
+ char **eglist;
+ int numeg;
+ int i, j, k, k1, k2, pos;
+ int *vv;
+ SNP *cupt;
+ Indiv *indx;
+ double y1 = 0, y2, y2l, y, y3;
+
+ int n0, n1, nkill;
+
+ int nindiv = 0;
+ double ychi, tail, tw;
+ int nignore, numrisks = 1;
+ double *xrow, *xpt;
+ SNP **xsnplist;
+ Indiv **xindlist;
+ int *xindex, *xtypes = NULL;
+ int nrows, ncols, m, nused;
+ double *XTX, *cc, *evecs, *ww;
double* partial_sum_lookup_buf = NULL;
- double *lambda, *esize ;
- double zn, zvar ;
- double *fvecs, *fxvecs, *fxscal ;
- double *ffvecs ;
- int weightmode = NO ;
- double ynrows ;
- int t, tt ;
- double *xmean, *xfancy ;
- double *ldvv = NULL , ynumsnps = 0 ; // for grm
- int *ldsnpbuff = NULL ;
- int lastldchrom, numld ;
- double *fstans, *fstsd ;
- double *inbans, *inbsd ;
-
- int chrom ;
- int outliter, numoutiter, *badlist, nbad ;
- FILE *outlfile, *phylipfile ;
- double *eigkurt, *eigindkurt ;
- double *wmean ;
- char **elist ;
- double *shrink ;
- double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL ;
- int kk ;
- double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq ;
-
-
- int xblock ;
+ double *lambda, *esize;
+ double zn, zvar;
+ double *fvecs, *fxvecs, *fxscal;
+ double *ffvecs;
+ int weightmode = NO;
+ double ynrows;
+ int t, tt;
+ double *xmean, *xfancy;
+ double *ldvv = NULL, ynumsnps = 0; // for grm
+ int *ldsnpbuff = NULL;
+ int lastldchrom, numld;
+ double *fstans, *fstsd;
+ double *inbans, *inbsd;
+
+ int chrom;
+ int outliter, numoutiter, *badlist, nbad;
+ FILE *outlfile, *phylipfile;
+ double *eigkurt, *eigindkurt;
+ double *wmean;
+ char **elist;
+ double *shrink;
+ double *trow = NULL, *rhs = NULL, *emat = NULL, *regans = NULL;
+ int kk;
+ double *acoeffs, *bcoeffs, *apt, *bpt, *azq, *bzq;
+
+ int xblock;
int blocksize = 1024;
double *tblock = NULL;
int* binary_rawcol = NULL;
uintptr_t* binary_cols = NULL;
uintptr_t* binary_mmask = NULL;
- OUTLINFO *outpt ;
+ OUTLINFO *outpt;
pthread_t threads[MAX_THREADS];
uint32_t thread_ct;
- readcommands(argc, argv) ;
- printf("## smartpca version: %s\n", WVERSION) ;
- packmode = YES ;
- setomode(&outputmode, omode) ;
-
- if (parname == NULL) return 0 ;
- if (xchrom == (numchrom+1)) noxdata = NO ;
-
- if (fastmode) {
- printf("fastmode => easymode\n") ;
- easymode = YES ;
- }
-
- if (usepopsformissing) {
- printf("usepopsformissing => easymode\n") ;
- easymode = YES ;
- }
+ readcommands (argc, argv);
+ printf ("## smartpca version: %s\n", WVERSION);
+ packmode = YES;
+ setomode (&outputmode, omode);
- if (deletesnpoutname != NULL) { /* remove because snplog opens in append mode */
- char buff[256];
- sprintf(buff,"rm -f %s", deletesnpoutname);
- system(buff);
- }
+ if (parname == NULL)
+ return 0;
+ if (xchrom == (numchrom + 1))
+ noxdata = NO;
- if (fstonly) {
- printf("fstonly\n") ;
- numeigs = 0 ;
- numoutliter = 0 ;
- numoutiter = 0 ;
- outputname = NULL ;
- snpeigname = NULL ;
- }
+ if (fastmode)
+ {
+ printf ("fastmode => easymode\n");
+ easymode = YES;
+ }
- if (fancynorm) printf("norm used\n\n") ;
- else printf("no norm used\n\n") ;
- if (regmode) printf("lsqproject used\n") ;
+ if (usepopsformissing)
+ {
+ printf ("usepopsformissing => easymode\n");
+ easymode = YES;
+ }
- nostatslim = MAX(nostatslim, 3) ;
+ if (deletesnpoutname != NULL)
+ { /* remove because snplog opens in append mode */
+ char buff[256];
+ sprintf (buff, "rm -f %s", deletesnpoutname);
+ system (buff);
+ }
- outlfile = ofile = stdout;
+ if (fstonly)
+ {
+ printf ("fstonly\n");
+ numeigs = 0;
+ numoutliter = 0;
+ numoutiter = 0;
+ outputname = NULL;
+ snpeigname = NULL;
+ }
- if (outputname != NULL) openit(outputname, &ofile, "w") ;
- if (outliername != NULL) openit(outliername, &outlfile, "w") ;
- if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ;
+ if (fancynorm)
+ printf ("norm used\n\n");
+ else
+ printf ("no norm used\n\n");
+ if (regmode)
+ printf ("lsqproject used\n");
- if ((ldlimit <= 0) || (ldposlimit<=0)) ldregress = 0 ;
+ nostatslim = MAX(nostatslim, 3);
- numsnps =
- getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ;
+ outlfile = ofile = stdout;
- numindivs = getindivs(indivname, &indivmarkers) ;
+ if (outputname != NULL)
+ openit (outputname, &ofile, "w");
+ if (outliername != NULL)
+ openit (outliername, &outlfile, "w");
+ if (fstdetailsname != NULL)
+ openit (fstdetailsname, &fstdetails, "w");
- if (id2pops != NULL) {
- setid2pops(id2pops, indivmarkers, numindivs) ;
- }
+ if ((ldlimit <= 0) || (ldposlimit <= 0))
+ ldregress = 0;
- k = getgenos(genotypename, snpmarkers, indivmarkers,
- numsnps, numindivs, nignore) ;
+ numsnps = getsnps (snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks);
+ numindivs = getindivs (indivname, &indivmarkers);
- if (poplistname != NULL)
- {
- ZALLOC(eglist, numindivs, char *) ;
- numeg = loadlist(eglist, poplistname) ;
- seteglist(indivmarkers, numindivs, poplistname);
- }
- else
- {
- setstatus(indivmarkers, numindivs, NULL) ;
- ZALLOC(eglist, MAXPOPS, char *) ;
- numeg = makeeglist(eglist, maxpops, indivmarkers, numindivs) ;
- }
- for (i=0; i<numeg; i++)
- {
- /* printf("%3d %s\n",i, eglist[i]) ; */
- }
+ if (id2pops != NULL)
+ {
+ setid2pops (id2pops, indivmarkers, numindivs);
+ }
- nindiv=0 ;
- for (i=0; i<numindivs; i++)
- {
- indx = indivmarkers[i] ;
- if(indx -> affstatus == YES) ++nindiv ;
- }
+ k = getgenos (genotypename, snpmarkers, indivmarkers, numsnps, numindivs,
+ nignore);
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- chrom = cupt -> chrom ;
- if ((noxdata) && (chrom == (numchrom+1))) {
- cupt-> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-X",deletesnpoutname);
- }
- if (chrom == 0) {
- cupt -> ignore = YES;
- logdeletedsnp(cupt->ID,"chrom-0",deletesnpoutname);
+ if (poplistname != NULL)
+ {
+ ZALLOC(eglist, numindivs, char *);
+ numeg = loadlist (eglist, poplistname);
+ seteglist (indivmarkers, numindivs, poplistname);
}
- if (chrom > (numchrom+1)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"chrom-big",deletesnpoutname);
+ else
+ {
+ setstatus (indivmarkers, numindivs, NULL);
+ ZALLOC(eglist, MAXPOPS, char *);
+ numeg = makeeglist (eglist, maxpops, indivmarkers, numindivs);
}
- }
- for (i=0; i<numsnps; i++)
- {
- cupt = snpmarkers[i] ;
- pos = nnint(cupt -> physpos) ;
- if ((xchrom>0) && (cupt -> chrom != xchrom)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"not-chrom",deletesnpoutname);
+ for (i = 0; i < numeg; i++)
+ {
+ /* printf("%3d %s\n",i, eglist[i]) ; */
}
- if ((xchrom > 0) && (pos < lopos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"lopos",deletesnpoutname);
+
+ nindiv = 0;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->affstatus == YES)
+ ++nindiv;
}
- if ((xchrom > 0) && (pos > hipos)) {
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"hipos",deletesnpoutname);
+
+ for (i = 0; i < numsnps; i++)
+ {
+ cupt = snpmarkers[i];
+ chrom = cupt->chrom;
+ if ((noxdata) && (chrom == (numchrom + 1)))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-X", deletesnpoutname);
+ }
+ if (chrom == 0)
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-0", deletesnpoutname);
+ }
+ if (chrom > (numchrom + 1))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "chrom-big", deletesnpoutname);
+ }
}
- if (cupt -> ignore) continue ;
- if (numvalidgtx(indivmarkers, cupt, YES) <= 1)
+ for (i = 0; i < numsnps; i++)
{
- printf("nodata: %20s\n", cupt -> ID) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"nodata",deletesnpoutname);
+ cupt = snpmarkers[i];
+ pos = nnint (cupt->physpos);
+ if ((xchrom > 0) && (cupt->chrom != xchrom))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "not-chrom", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos < lopos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "lopos", deletesnpoutname);
+ }
+ if ((xchrom > 0) && (pos > hipos))
+ {
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "hipos", deletesnpoutname);
+ }
+ if (cupt->ignore)
+ continue;
+ if (numvalidgtx (indivmarkers, cupt, YES) <= 1)
+ {
+ printf ("nodata: %20s\n", cupt->ID);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "nodata", deletesnpoutname);
+ }
}
- }
-
- if (killr2) {
- nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ;
- if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ;
- }
- if ( xregionname ) {
- excluderegions(xregionname, snpmarkers, numsnps, deletesnpoutname);
- }
+ if (killr2)
+ {
+ nkill = killhir2 (snpmarkers, numsnps, numindivs, r2physlim, r2genlim,
+ r2thresh);
+ if (nkill > 0)
+ printf ("killhir2. number of snps killed: %d\n", nkill);
+ }
- if ( nhwfilter > 0 ) {
- hwfilter(snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
- }
+ if (xregionname)
+ {
+ excluderegions (xregionname, snpmarkers, numsnps, deletesnpoutname);
+ }
- ZALLOC(vv, numindivs, int) ;
- numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ;
- for (i=0; i<numindivs; ++i) {
- if (vv[i] == 0) {
- indx = indivmarkers[i] ;
- indx -> ignore = YES ;
- }
- }
- free(vv) ;
+ if (nhwfilter > 0)
+ {
+ hwfilter (snpmarkers, numsnps, numindivs, nhwfilter, deletesnpoutname);
+ }
- numsnps = rmsnps(snpmarkers, numsnps, deletesnpoutname) ; // rid ignorable snps
+ ZALLOC(vv, numindivs, int);
+ numvalidgtallind (vv, snpmarkers, numsnps, numindivs);
+ for (i = 0; i < numindivs; ++i)
+ {
+ if (vv[i] == 0)
+ {
+ indx = indivmarkers[i];
+ indx->ignore = YES;
+ }
+ }
+ free (vv);
-
- if (missingmode)
- {
- setmiss(snpmarkers, numsnps) ;
- fancynorm = NO ;
- }
+ numsnps = rmsnps (snpmarkers, numsnps, deletesnpoutname); // rid ignorable snps
- if (weightname != NULL)
- {
- weightmode = YES ;
- getweights(weightname, snpmarkers, numsnps) ;
- }
- if (ldregress>0)
- {
- ZALLOC(ldvv, ldregress*numindivs, double) ;
- ZALLOC(ldsnpbuff, ldregress, int) ; // index of snps
- }
+ if (missingmode)
+ {
+ setmiss (snpmarkers, numsnps);
+ fancynorm = NO;
+ }
- ZALLOC(xindex, numindivs, int) ;
- ZALLOC(xindlist, numindivs, Indiv *) ;
- ZALLOC(xsnplist, numsnps, SNP *) ;
+ if (weightname != NULL)
+ {
+ weightmode = YES;
+ getweights (weightname, snpmarkers, numsnps);
+ }
+ if (ldregress > 0)
+ {
+ ZALLOC(ldvv, ldregress*numindivs, double);
+ ZALLOC(ldsnpbuff, ldregress, int); // index of snps
+ }
- if (popsizelimit > 0)
- {
- setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ;
- }
+ ZALLOC(xindex, numindivs, int);
+ ZALLOC(xindlist, numindivs, Indiv *);
+ ZALLOC(xsnplist, numsnps, SNP *);
+ if (popsizelimit > 0)
+ {
+ setplimit (indivmarkers, numindivs, eglist, numeg, popsizelimit);
+ }
/* Load non-ignored individuals into xindlist,xindex:
* xindex[i] = index into indivmarkers
* xindlist[i] = pointer to Indiv struct */
- ZALLOC(xtypes, numindivs, int) ;
-
-
+ ZALLOC(xtypes, numindivs, int);
/* Load non-ignored SNPs into xsnplist:
* xsnplist[i] = pointer to SNP struct */
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
-
- printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ;
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
- if (fastmode) {
+ printf ("number of samples used: %d number of snps used: %d\n", nrows, ncols);
- dofast(snpmarkers, indivmarkers, numsnps, numindivs, numeigs, ofile) ;
+ if (fastmode)
+ {
- printf("end of smartpca(fastmode)\n") ;
- return 0 ;
+ dofast (snpmarkers, indivmarkers, numsnps, numindivs, numeigs, ofile);
+ printf ("end of smartpca(fastmode)\n");
+ return 0;
- }
+ }
/* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */
- ZALLOC(xmean, ncols, double) ;
- ZALLOC(xfancy, ncols, double) ;
-
- ZALLOC(XTX, nrows*nrows, double) ;
- ZALLOC(evecs, nrows*nrows, double) ;
- if ((!usepopsformissing) && (ldregress == 0)) {
- // should not use lookup table if
- // - usepopsformissing is set (since each population may have a different
- // mean), or
- // - ldregress > 0
+ ZALLOC(xmean, ncols, double);
+ ZALLOC(xfancy, ncols, double);
+
+ ZALLOC(XTX, nrows*nrows, double);
+ ZALLOC(evecs, nrows*nrows, double);
+ if ((!usepopsformissing) && (ldregress == 0))
+ {
+ // should not use lookup table if
+ // - usepopsformissing is set (since each population may have a different
+ // mean), or
+ // - ldregress > 0
#ifdef __LP64__
- blocksize = 20;
- ZALLOC(partial_sum_lookup_buf, 131072, double);
+ blocksize = 20;
+ ZALLOC(partial_sum_lookup_buf, 131072, double);
#else
- blocksize = 10;
- ZALLOC(partial_sum_lookup_buf, 65536, double);
+ blocksize = 10;
+ ZALLOC(partial_sum_lookup_buf, 65536, double);
#endif
- ZALLOC(binary_rawcol, nrows, int);
- ZALLOC(binary_cols, nrows, uintptr_t);
- ZALLOC(binary_mmask, nrows, uintptr_t);
- ZALLOC(tblock, 3 * blocksize, double);
- } else {
- ZALLOC(tblock, nrows*blocksize, double) ;
- }
+ ZALLOC(binary_rawcol, nrows, int);
+ ZALLOC(binary_cols, nrows, uintptr_t);
+ ZALLOC(binary_mmask, nrows, uintptr_t);
+ ZALLOC(tblock, 3 * blocksize, double);
+ }
+ else
+ {
+ ZALLOC(tblock, nrows*blocksize, double);
+ }
- ZALLOC(lambda, nrows, double) ;
- ZALLOC(esize, nrows, double) ;
- ZALLOC(cc, (nrows > 3)? nrows : 3, double) ;
- ZALLOC(ww, nrows, double) ;
- ZALLOC(badlist, nrows, int) ;
+ ZALLOC(lambda, nrows, double);
+ ZALLOC(esize, nrows, double);
+ ZALLOC(cc, (nrows > 3)? nrows : 3, double);
+ ZALLOC(ww, nrows, double);
+ ZALLOC(badlist, nrows, int);
- blocksize = MIN(blocksize, ncols) ;
+ blocksize = MIN(blocksize, ncols);
// xfancy is multiplier for column xmean is mean to take off
// badlist is list of rows to delete (outlier removal)
- numoutiter = 1 ;
+ numoutiter = 1;
- if (numoutliter>=1)
- {
- numoutiter = numoutliter+1 ;
- ZALLOC(outinfo, nrows, OUTLINFO *) ;
- for (k=0; k<nrows; k++)
- {
- ZALLOC(outinfo[k], 1, OUTLINFO) ;
- }
- /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
- setoutliermode(outliermode) ;
- }
- else setoutliermode(2) ;
+ if (numoutliter >= 1)
+ {
+ numoutiter = numoutliter + 1;
+ ZALLOC(outinfo, nrows, OUTLINFO *);
+ for (k = 0; k < nrows; k++)
+ {
+ ZALLOC(outinfo[k], 1, OUTLINFO);
+ }
+ /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */
+ setoutliermode (outliermode);
+ }
+ else
+ setoutliermode (2);
// try to autodetect number of (virtual) processors, and use that number to
// set the thread count. allow the user to override this in the future
#if _WIN32
SYSTEM_INFO sysinfo;
- if (thread_ct_config <= 0) {
- GetSystemInfo(&sysinfo);
- thread_ct = sysinfo.dwNumberOfProcessors;
- } else {
- thread_ct = thread_ct_config;
- }
+ if (thread_ct_config <= 0)
+ {
+ GetSystemInfo(&sysinfo);
+ thread_ct = sysinfo.dwNumberOfProcessors;
+ }
+ else
+ {
+ thread_ct = thread_ct_config;
+ }
#else
- if (thread_ct_config <= 0) {
- i = sysconf(_SC_NPROCESSORS_ONLN);
- if (i == -1) {
- thread_ct = 1;
- } else {
- thread_ct = i;
- }
- } else {
- thread_ct = thread_ct_config;
- }
-#endif
- if (thread_ct > 8) {
- if (thread_ct > MAX_THREADS) {
- thread_ct = MAX_THREADS;
- } else {
- thread_ct--;
+ if (thread_ct_config <= 0)
+ {
+ i = sysconf (_SC_NPROCESSORS_ONLN);
+ if (i == -1)
+ {
+ thread_ct = 1;
+ }
+ else
+ {
+ thread_ct = i;
+ }
}
- }
- if (thread_ct > nrows * 2) {
- thread_ct = nrows / 2;
- if (!thread_ct) {
- thread_ct = 1;
+ else
+ {
+ thread_ct = thread_ct_config;
}
- }
- printf("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1)? "" : "s", (partial_sum_lookup_buf)? ", and partial sum lookup algorithm" : "");
- triangle_fill(g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
-
- nkill = 0 ;
-
- for (outliter = 1; outliter <= numoutiter ; ++outliter) {
-
- if (fstonly) {
- setidmat(XTX, nrows) ;
- vclear(lambda, 1.0, nrows) ;
- break ;
+#endif
+ if (thread_ct > 8)
+ {
+ if (thread_ct > MAX_THREADS)
+ {
+ thread_ct = MAX_THREADS;
+ }
+ else
+ {
+ thread_ct--;
+ }
}
- if (outliter>1) {
- ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ;
+ if (thread_ct > nrows * 2)
+ {
+ thread_ct = nrows / 2;
+ if (!thread_ct)
+ {
+ thread_ct = 1;
+ }
}
+ printf ("Using %u thread%s%s.\n", thread_ct, (thread_ct == 1) ? "" : "s",
+ (partial_sum_lookup_buf) ? ", and partial sum lookup algorithm" : "");
+ triangle_fill (g_thread_start, nrows, thread_ct, 0, 1, 0, 1);
- vzero(XTX, (nrows*(nrows+1)) / 2) ;
- xblock = 0 ;
-
- vzero(xmean, ncols) ;
- vclear(xfancy, 1.0, ncols) ;
+ nkill = 0;
- nused = 0 ;
- for (i=0; i<nrows; i++) {
- indx = xindlist[i] ;
- k= indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
- }
+ for (outliter = 1; outliter <= numoutiter; ++outliter)
+ {
- numld = 0 ;
- lastldchrom = -1 ;
- ynumsnps = 0 ;
- if (partial_sum_lookup_buf) {
- for (i = 0; i < nrows; i++) {
- binary_cols[i] = 0;
- }
- for (i = 0; i < nrows; i++) {
- binary_mmask[i] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- vzero(tblock, nrows*blocksize) ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- chrom = cupt -> chrom ;
- if (!partial_sum_lookup_buf) {
- tt = getcolxz(cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy, &n0, &n1) ;
- } else {
- tt = getcolxz_binary1(binary_rawcol, cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1);
- }
+ if (fstonly)
+ {
+ setidmat (XTX, nrows);
+ vclear (lambda, 1.0, nrows);
+ break;
+ }
+ if (outliter > 1)
+ {
+ ncols = loadsnpx (xsnplist, snpmarkers, numsnps, indivmarkers);
+ }
- t = MIN(n0, n1) ;
-
- if ((t < minallelecnt) || (tt >maxmissing) || (tt<0) || (t==0)) {
- t = MAX(t, 0) ;
- tt = MAX(tt, 0) ;
- cupt -> ignore = YES ;
- logdeletedsnp(cupt->ID,"minallelecnt",deletesnpoutname);
- vzero(cc, nrows) ;
- if (nkill < 10) printf(" snp %20s ignored . allelecnt: %5d missing: %5d\n", cupt -> ID, t, tt) ;
- ++nkill ;
- continue ;
- }
+ vzero (XTX, (nrows * (nrows + 1)) / 2);
+ xblock = 0;
- if (lastldchrom != chrom) numld = 0 ;
-
- if (!partial_sum_lookup_buf) {
- if (weightmode)
- {
- vst(cc, cc, xsnplist[i] -> weight, nrows) ;
- }
-
-
- if (ldregress>0)
- {
-
- t = ldregx(ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi) ;
- if (t<2) {
- bumpldvv(ldvv, cc, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- ynumsnps += asum2(ww, nrows)/ asum2(cc, nrows) ;
- // don't need to think hard about how cc is normalizes
- } else {
- // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
- bumpldvv(ldvv, ww, &numld, ldregress, nrows, ldsnpbuff, i) ;
- lastldchrom = chrom ;
- }
- copyarr(ww, cc, nrows) ;
- }
- else ++ynumsnps ;
- copyarr(cc, tblock+xblock*nrows, nrows) ;
- } else {
- getcolxz_binary2(binary_rawcol, binary_cols, binary_mmask, xblock, nrows);
- if (weightmode) {
- vst(cc, cc, xsnplist[i]->weight, 3);
- }
- ++ynumsnps;
- copyarr(cc, &(tblock[xblock * 3]), 3);
- }
+ vzero (xmean, ncols);
+ vclear (xfancy, 1.0, ncols);
- ++xblock ;
- ++nused ;
+ nused = 0;
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
+ }
-/** this is the key code to parallelize */
- if (xblock==blocksize)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- for (j = 0; j < nrows; j++) {
- binary_cols[j] = 0;
- }
- for (j = 0; j < nrows; j++) {
- binary_mmask[j] = 0;
- }
- vzero(tblock, 3 * blocksize);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- vzero(tblock, nrows*blocksize) ;
- }
- xblock = 0 ;
- }
- }
+ numld = 0;
+ lastldchrom = -1;
+ ynumsnps = 0;
+ if (partial_sum_lookup_buf)
+ {
+ for (i = 0; i < nrows; i++)
+ {
+ binary_cols[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ binary_mmask[i] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ vzero (tblock, nrows * blocksize);
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ chrom = cupt->chrom;
+ if (!partial_sum_lookup_buf)
+ {
+ tt = getcolxz (cc, cupt, xindex, xtypes, nrows, i, xmean, xfancy,
+ &n0, &n1);
+ }
+ else
+ {
+ tt = getcolxz_binary1 (binary_rawcol, cc, cupt, xindex, nrows, i,
+ xmean, xfancy, &n0, &n1);
+ }
+
+ t = MIN(n0, n1);
+
+ if ((t < minallelecnt) || (tt > maxmissing) || (tt < 0) || (t == 0))
+ {
+ t = MAX(t, 0);
+ tt = MAX(tt, 0);
+ cupt->ignore = YES;
+ logdeletedsnp (cupt->ID, "minallelecnt", deletesnpoutname);
+ vzero (cc, nrows);
+ if (nkill < 10)
+ printf (" snp %20s ignored . allelecnt: %5d missing: %5d\n",
+ cupt->ID, t, tt);
+ ++nkill;
+ continue;
+ }
+
+ if (lastldchrom != chrom)
+ numld = 0;
+
+ if (!partial_sum_lookup_buf)
+ {
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, nrows);
+ }
+
+ if (ldregress > 0)
+ {
+
+ t = ldregx (ldvv, cc, ww, numld, nrows, ldr2lo, ldr2hi);
+ if (t < 2)
+ {
+ bumpldvv (ldvv, cc, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ ynumsnps += asum2 (ww, nrows) / asum2 (cc, nrows);
+ // don't need to think hard about how cc is normalizes
+ }
+ else
+ {
+ // Ignore this SNP and exclude from further regressions (*ww is returned as all zeroes)
+ bumpldvv (ldvv, ww, &numld, ldregress, nrows, ldsnpbuff,
+ i);
+ lastldchrom = chrom;
+ }
+ copyarr (ww, cc, nrows);
+ }
+ else
+ ++ynumsnps;
+ copyarr (cc, tblock + xblock * nrows, nrows);
+ }
+ else
+ {
+ getcolxz_binary2 (binary_rawcol, binary_cols, binary_mmask,
+ xblock, nrows);
+ if (weightmode)
+ {
+ vst (cc, cc, xsnplist[i]->weight, 3);
+ }
+ ++ynumsnps;
+ copyarr (cc, &(tblock[xblock * 3]), 3);
+ }
+
+ ++xblock;
+ ++nused;
+
+ /** this is the key code to parallelize */
+ if (xblock == blocksize)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock,
+ nrows, partial_sum_lookup_buf);
+ for (j = 0; j < nrows; j++)
+ {
+ binary_cols[j] = 0;
+ }
+ for (j = 0; j < nrows; j++)
+ {
+ binary_mmask[j] = 0;
+ }
+ vzero (tblock, 3 * blocksize);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock,
+ xblock, nrows);
+ vzero (tblock, nrows * blocksize);
+ }
+ xblock = 0;
+ }
+ }
- if (xblock>0)
- {
- if (partial_sum_lookup_buf) {
- domult_increment_lookup(threads, thread_ct, XTX, tblock, binary_cols, binary_mmask, xblock, nrows, partial_sum_lookup_buf);
- } else {
- domult_increment_normal(threads, thread_ct, XTX, tblock, xblock, nrows);
- }
- }
- symit2(XTX, nrows) ;
- printf("total number of snps killed in pass: %d used: %d\n", nkill, nused) ;
+ if (xblock > 0)
+ {
+ if (partial_sum_lookup_buf)
+ {
+ domult_increment_lookup (threads, thread_ct, XTX, tblock,
+ binary_cols, binary_mmask, xblock, nrows,
+ partial_sum_lookup_buf);
+ }
+ else
+ {
+ domult_increment_normal (threads, thread_ct, XTX, tblock, xblock,
+ nrows);
+ }
+ }
+ symit2 (XTX, nrows);
+ printf ("total number of snps killed in pass: %d used: %d\n", nkill,
+ nused);
- if (verbose)
- {
- printdiag(XTX, nrows) ;
- }
+ if (verbose)
+ {
+ printdiag (XTX, nrows);
+ }
- y = trace(XTX, nrows) / (double) (nrows-1) ;
- if (isnan(y)) fatalx("bad XTX matrix\n") ;
- /* printf("trace: %9.3f\n", y) ; */
- if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ;
- vst(XTX, XTX, 1.0/y, nrows * nrows) ;
+ y = trace (XTX, nrows) / (double) (nrows - 1);
+ if (isnan(y))
+ fatalx ("bad XTX matrix\n");
+ /* printf("trace: %9.3f\n", y) ; */
+ if (y <= 0.0)
+ fatalx ("XTX has zero trace (perhaps no data)\n");
+ vst (XTX, XTX, 1.0 / y, nrows * nrows);
- eigvecs(XTX, lambda, evecs, nrows) ;
+ eigvecs (XTX, lambda, evecs, nrows);
// eigenvalues are in decreasing order
- if (outliter > numoutliter) break ;
- // last pass skips outliers
- numoutleigs = MIN(numoutleigs, nrows-1) ;
- nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ;
- if (nbad == 0) break ;
- for (i=0; i<nbad; i++)
- {
- j = badlist[i] ;
- indx = xindlist[j] ;
- outpt = outinfo[j] ;
- fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
- indx -> ID, outliter, outpt -> vecno, outpt -> score, indx -> egroup) ;
- indx -> ignore = YES ;
- }
- nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ;
- printf("number of samples after outlier removal: %d\n", nrows) ;
- }
+ if (outliter > numoutliter)
+ break;
+ // last pass skips outliers
+ numoutleigs = MIN(numoutleigs, nrows - 1);
+ nbad = ridoutlier (evecs, nrows, numoutleigs, outlthresh, badlist,
+ outinfo);
+ if (nbad == 0)
+ break;
+ for (i = 0; i < nbad; i++)
+ {
+ j = badlist[i];
+ indx = xindlist[j];
+ outpt = outinfo[j];
+ fprintf (outlfile,
+ "REMOVED outlier %s iter %d evec %d sigmage %.3f pop: %s\n",
+ indx->ID, outliter, outpt->vecno, outpt->score,
+ indx->egroup);
+ indx->ignore = YES;
+ }
+ nrows = loadindx (xindlist, xindex, indivmarkers, numindivs);
+ printf ("number of samples after outlier removal: %d\n", nrows);
+ }
- if (outliername != NULL) fclose(outlfile) ;
- dumpgrm(XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname) ;
- if (grmoutname != NULL) printf("grm dumped\n");
+ if (outliername != NULL)
+ fclose (outlfile);
+ dumpgrm (XTX, xindex, nrows, ynumsnps, indivmarkers, numindivs, grmoutname);
+ if (grmoutname != NULL)
+ printf ("grm dumped\n");
- m = numgtz(lambda, nrows) ;
+ m = numgtz (lambda, nrows);
/* printf("matrix rank: %d\n", m) ; */
- if (m==0) fatalx("no data\n") ;
+ if (m == 0)
+ fatalx ("no data\n");
/* Now, print Tracy-Widom stats, if twtable is valid */
- if (settwxtable(twxtabname)<0)
- {
- printf("\n## To get Tracy-Widom statistics: recompile smartpca with");
- printf(" TWTAB correctly specified in Makefile, or\n");
- printf(" just run twstats (see README file in POPGEN directory)\n");
- }
+ if (settwxtable (twxtabname) < 0)
+ {
+ printf ("\n## To get Tracy-Widom statistics: recompile smartpca with");
+ printf (" TWTAB correctly specified in Makefile, or\n");
+ printf (" just run twstats (see README file in POPGEN directory)\n");
+ }
else
- {
- /* *** START of code to print Tracy-Widom statistics */
- printf("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows, ncols);
- y = -1.0 ;
- printf("%4s %12s", "#N", "eigenvalue") ;
- printf("%12s", "difference") ;
- printf(" %9s %12s", "twstat", "p-value") ;
- printf(" %9s", "effect. n") ;
- printf("\n") ;
-
- ynrows = (double) nrows ;
-
- for (i=0; i<m; ++i) {
- if (fstonly) break ;
- zn = znval ;
- if (zn>0) zn = MAX(ynrows, zn) ;
- tail = dotwcalc(lambda+i, m-i, &tw, &zn, &zvar, nostatslim) ;
- esize[i] = zn ;
- printf("%4d %12.6f", i+1, lambda[i]) ;
- if (i==0) printf( "%12s", "NA") ;
- else printf("%12.6f", lambda[i]-lambda[i-1]) ;
- if (tail>=0.0) printf( " %9.3f %12.6g", tw, tail) ;
- else printf( " %9s %12s", "NA", "NA") ;
- if (zn>0.0)
- {
- printf( " %9.3f", zn) ;
- }
- else
- {
- printf( " %9s", "NA") ;
- }
- printf( "\n") ;
+ {
+ /* *** START of code to print Tracy-Widom statistics */
+ printf ("\n## Tracy-Widom statistics: rows: %d cols: %d\n", nrows,
+ ncols);
+ y = -1.0;
+ printf ("%4s %12s", "#N", "eigenvalue");
+ printf ("%12s", "difference");
+ printf (" %9s %12s", "twstat", "p-value");
+ printf (" %9s", "effect. n");
+ printf ("\n");
+
+ ynrows = (double) nrows;
+
+ for (i = 0; i < m; ++i)
+ {
+ if (fstonly)
+ break;
+ zn = znval;
+ if (zn > 0)
+ zn = MAX(ynrows, zn);
+ tail = dotwcalc (lambda + i, m - i, &tw, &zn, &zvar, nostatslim);
+ esize[i] = zn;
+ printf ("%4d %12.6f", i + 1, lambda[i]);
+ if (i == 0)
+ printf ("%12s", "NA");
+ else
+ printf ("%12.6f", lambda[i] - lambda[i - 1]);
+ if (tail >= 0.0)
+ printf (" %9.3f %12.6g", tw, tail);
+ else
+ printf (" %9s %12s", "NA", "NA");
+ if (zn > 0.0)
+ {
+ printf (" %9.3f", zn);
+ }
+ else
+ {
+ printf (" %9s", "NA");
+ }
+ printf ("\n");
+ }
+ /* END of code to print Tracy-Widom statistics */
}
- /* END of code to print Tracy-Widom statistics */
- }
- numeigs = MIN(numeigs, nrows) ;
- numeigs = MIN(numeigs, ncols) ;
-
- ZALLOC(shrink, numeigs, double) ;
- vclear(shrink, 1.0, numeigs) ;
- t = nrows - numeigs ;
- if (t>0) y1 = asum(lambda+numeigs, t)/(double) t ;
- y = (double) nrows / esize[numeigs] ;
- y = MIN(y, 1.0/y) ; // gamma
- for (j=0; j<numeigs; j++) {
- if (!shrinkmode) break ;
- if (t<=0) break ;
- if (esize[j] < 0.1) break ;
- y2 = lambda[j]/y1 ;
+ numeigs = MIN(numeigs, nrows);
+ numeigs = MIN(numeigs, ncols);
+
+ ZALLOC(shrink, numeigs, double);
+ vclear (shrink, 1.0, numeigs);
+ t = nrows - numeigs;
+ if (t > 0)
+ y1 = asum (lambda + numeigs, t) / (double) t;
+ y = (double) nrows / esize[numeigs];
+ y = MIN(y, 1.0 / y); // gamma
+ for (j = 0; j < numeigs; j++)
+ {
+ if (!shrinkmode)
+ break;
+ if (t <= 0)
+ break;
+ if (esize[j] < 0.1)
+ break;
+ y2 = lambda[j] / y1;
// this is d after normalization (Baik Silverman); now estimate true eigenvalue
- y2l = rhoinv(y2, y) ;
- if (y2l<0.0) break ;
- y3 = (y2l-1.0)/(y2l+y-1.0) ;
- y3 = MIN(y3, 1.0) ;
- if (y3<0.0) y3 = 1.0 ;
- shrink[j] = y3 ;
- printf("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l) ;
- }
+ y2l = rhoinv (y2, y);
+ if (y2l < 0.0)
+ break;
+ y3 = (y2l - 1.0) / (y2l + y - 1.0);
+ y3 = MIN(y3, 1.0);
+ if (y3 < 0.0)
+ y3 = 1.0;
+ shrink[j] = y3;
+ printf ("shrink: %3d %9.3f %9.3f %9.3f\n", j, shrink[j], y2, y2l);
+ }
/* fprintf(ofile, "##genotypes: %s\n", genotypename) ; */
/* fprintf(ofile, "##numrows(indivs):: %d\n", nrows) ; */
/* fprintf(ofile, "##numcols(snps):: %d\n", ncols) ; */
/* fprintf(ofile, "##numeigs:: %d\n", numeigs) ; */
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", lambda[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- if (outputvname != NULL) {
- openit(outputvname, &ovfile, "w") ;
- for (j=0; j<nrows; j++) {
- fprintf(ovfile, "%12.6f\n", lambda[j]) ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", lambda[j]);
}
- fclose(ovfile) ;
- }
-
- ZALLOC(fvecs, nrows*numeigs, double) ;
- ZALLOC(fxvecs, nrows*numeigs, double) ;
- ZALLOC(fxscal, numeigs, double) ;
+ fprintf (ofile, "\n");
- ZALLOC(ffvecs, ncols*numeigs, double) ;
- ZALLOC(xrow, ncols, double) ;
- setfvecs(fvecs, evecs, nrows, numeigs) ;
-
- if (easymode) {
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = asum2(xpt, nrows) ;
- vst(xpt, xpt, 1.0/sqrt(y), nrows) ; // norm 1
- }
- for (i=0; i < nrows ; i++) {
- indx = xindlist[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- y = xpt[i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- if (pubmean) {
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
-
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ if (outputvname != NULL)
+ {
+ openit (outputvname, &ovfile, "w");
+ for (j = 0; j < nrows; j++)
+ {
+ fprintf (ovfile, "%12.6f\n", lambda[j]);
}
- }
+ fclose (ovfile);
}
-
- printf("## easymode set. end of smartpca run\n") ;
- return 0 ;
- }
- for (i=0; i<ncols; i++) {
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- for (j=0; j<numeigs; j++) {
- for (k=0; k<nrows; k++) {
- ffvecs[j*ncols+i] += fvecs[j*nrows+k]*cc[k] ;
- }
- }
- }
+ ZALLOC(fvecs, nrows*numeigs, double);
+ ZALLOC(fxvecs, nrows*numeigs, double);
+ ZALLOC(fxscal, numeigs, double);
- ZALLOC(eigkurt, numeigs, double) ;
- ZALLOC(eigindkurt, numeigs, double) ;
+ ZALLOC(ffvecs, ncols*numeigs, double);
+ ZALLOC(xrow, ncols, double);
+ setfvecs (fvecs, evecs, nrows, numeigs);
- for (j=0; j<numeigs; ++j) {
- eigkurt[j] = kurtosis(ffvecs+j*ncols, ncols) ;
- eigindkurt[j] = kurtosis(fvecs+j*nrows, nrows) ;
- }
-
- for (i=0; i<nrows; i++) {
+ if (easymode)
+ {
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = asum2 (xpt, nrows);
+ vst (xpt, xpt, 1.0 / sqrt (y), nrows); // norm 1
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ indx = xindlist[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ y = xpt[i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ if (pubmean)
+ {
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(elist, numeg, char *);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ xpt = fvecs + j * nrows;
+ calcpopmean (wmean, elist, xpt, eglist, numeg, xtypes, nrows);
+ printf ("eig: %d ", j + 1);
+ printf ("min: %s %9.3f ", elist[0], wmean[0]);
+ printf ("max: %s %9.3f ", elist[numeg - 1], wmean[numeg - 1]);
+ printnl ();
+ for (k = 0; k < numeg; ++k)
+ {
+ printf ("%20s ", elist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
+ }
+ }
- indx = xindlist[i] ;
- k = indxindex(eglist, numeg, indx -> egroup) ;
- xtypes[i] = k ;
+ printf ("## easymode set. end of smartpca run\n");
+ return 0;
+ }
+ for (i = 0; i < ncols; i++)
+ {
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ for (k = 0; k < nrows; k++)
+ {
+ ffvecs[j * ncols + i] += fvecs[j * nrows + k] * cc[k];
+ }
+ }
+ }
- loadxdataind(xrow, xsnplist, xindex[i], ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
+ ZALLOC(eigkurt, numeigs, double);
+ ZALLOC(eigindkurt, numeigs, double);
- for (j=0; j<numeigs; j++) {
+ for (j = 0; j < numeigs; ++j)
+ {
+ eigkurt[j] = kurtosis (ffvecs + j * ncols, ncols);
+ eigindkurt[j] = kurtosis (fvecs + j * nrows, nrows);
+ }
- xpt = ffvecs+j*ncols ;
- y = fxvecs[j*nrows+i] = vdot(xrow, xpt, ncols) ;
- fxscal[j] += y*y ;
-
- }
- }
+ for (i = 0; i < nrows; i++)
+ {
- for (j=0; j<numeigs; j++) {
- y = fxscal[j] ;
-// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
- fxscal[j] = 1.0/sqrt(y) ; // standard
- }
+ indx = xindlist[i];
+ k = indxindex (eglist, numeg, indx->egroup);
+ xtypes[i] = k;
-
- ZALLOC(acoeffs, numindivs*numeigs, double) ;
- ZALLOC(bcoeffs, numindivs*numeigs, double) ;
- if (partial_sum_lookup_buf) {
- free(partial_sum_lookup_buf);
- free(binary_rawcol);
- free(binary_cols);
- free(binary_mmask);
- }
- free(tblock);
- if (regmode) {
- ZALLOC(trow, ncols, double) ;
- ZALLOC(rhs, ncols, double) ;
- ZALLOC(emat, ncols*numeigs, double) ;
- ZALLOC(regans, numeigs, double) ;
-/**
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- fxscal[j] = (double) ncols / sqrt(y*y) ;
- }
-*/
- }
+ loadxdataind (xrow, xsnplist, xindex[i], ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+ for (j = 0; j < numeigs; j++)
+ {
- for (i=0; i < numindivs ; i++) {
- if (!regmode) break ;
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- copyarr(xrow, trow, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- kk = 0 ;
- for (k=0; k<ncols; ++k) {
- if (trow[k]<0) continue ;
- rhs[kk] = xrow[k] ;
- for (j=0; j<numeigs; j++) {
- emat[kk*numeigs+j] = fxscal[j]*ffvecs[j*ncols+k] ;
- }
- ++kk ;
- }
- if (kk <= numeigs) {
- indx -> ignore = YES ;
- printf("%s ignored (insufficient data\n", indx -> ID) ;
- continue ;
- }
- regressit(regans, emat, rhs, kk, numeigs) ;
- for (j=0; j<numeigs; ++j) {
- acoeffs[j*numindivs+i] = regans[j] ;
- }
- }
+ xpt = ffvecs + j * ncols;
+ y = fxvecs[j * nrows + i] = vdot (xrow, xpt, ncols);
+ fxscal[j] += y * y;
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- loadxdataind(xrow, xsnplist, i, ncols) ;
- fixxrow(xrow, xmean, xfancy, ncols) ;
-
- for (j=0; j<numeigs; j++) {
- y = fxscal[j]*vdot(xrow, ffvecs+j*ncols, ncols) ;
- if (shrinkmode && (indx -> affstatus == YES)) y *=shrink[j] ;
- bcoeffs[j*numindivs+i] = y ;
- }
- }
+ }
+ }
- if (!regmode) {
- free(acoeffs) ;
- acoeffs = bcoeffs ;
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j];
+// fxscal[j] = 10.0/sqrt(y) ; // eigenvectors have norm 10 (perhaps eccentric)
+ fxscal[j] = 1.0 / sqrt (y); // standard
+ }
- ZALLOC(azq, nrows*numeigs, double) ;
- ZALLOC(bzq, nrows*numeigs, double) ;
+ ZALLOC(acoeffs, numindivs*numeigs, double);
+ ZALLOC(bcoeffs, numindivs*numeigs, double);
+ if (partial_sum_lookup_buf)
+ {
+ free (partial_sum_lookup_buf);
+ free (binary_rawcol);
+ free (binary_cols);
+ free (binary_mmask);
+ }
+ free (tblock);
+ if (regmode)
+ {
+ ZALLOC(trow, ncols, double);
+ ZALLOC(rhs, ncols, double);
+ ZALLOC(emat, ncols*numeigs, double);
+ ZALLOC(regans, numeigs, double);
+ /**
+ for (j=0; j<numeigs; ++j) {
+ xpt = ffvecs+j*ncols ;
+ y = asum2(xpt, ncols) ;
+ fxscal[j] = (double) ncols / sqrt(y*y) ;
+ }
+ */
+ }
- sqz(azq, acoeffs, numeigs, nrows, xindex) ;
- sqz(bzq, bcoeffs, numeigs, nrows, xindex) ;
+ for (i = 0; i < numindivs; i++)
+ {
+ if (!regmode)
+ break;
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ copyarr (xrow, trow, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ kk = 0;
+ for (k = 0; k < ncols; ++k)
+ {
+ if (trow[k] < 0)
+ continue;
+ rhs[kk] = xrow[k];
+ for (j = 0; j < numeigs; j++)
+ {
+ emat[kk * numeigs + j] = fxscal[j] * ffvecs[j * ncols + k];
+ }
+ ++kk;
+ }
+ if (kk <= numeigs)
+ {
+ indx->ignore = YES;
+ printf ("%s ignored (insufficient data\n", indx->ID);
+ continue;
+ }
+ regressit (regans, emat, rhs, kk, numeigs);
+ for (j = 0; j < numeigs; ++j)
+ {
+ acoeffs[j * numindivs + i] = regans[j];
+ }
+ }
- for (j=0; j<numeigs; ++j) {
- if (!regmode) break ;
- apt = azq + j*nrows ;
- bpt = bzq + j*nrows ;
- y = vdot(apt, bpt, nrows) / vdot(apt, apt, nrows) ;
- vst(acoeffs+j*numindivs, acoeffs+j*numindivs, y, numindivs) ;
- }
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ loadxdataind (xrow, xsnplist, i, ncols);
+ fixxrow (xrow, xmean, xfancy, ncols);
+
+ for (j = 0; j < numeigs; j++)
+ {
+ y = fxscal[j] * vdot (xrow, ffvecs + j * ncols, ncols);
+ if (shrinkmode && (indx->affstatus == YES))
+ y *= shrink[j];
+ bcoeffs[j * numindivs + i] = y;
+ }
+ }
+ if (!regmode)
+ {
+ free (acoeffs);
+ acoeffs = bcoeffs;
+ }
- for (i=0; i < numindivs ; i++) {
- indx = indivmarkers[i] ;
- if (indx -> ignore) continue ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = acoeffs[j*numindivs+i] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- if ( qtmode ) {
- fprintf(ofile, "%15.6e\n", indx -> qval) ;
- }
- else {
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
- }
+ ZALLOC(azq, nrows*numeigs, double);
+ ZALLOC(bzq, nrows*numeigs, double);
+ sqz (azq, acoeffs, numeigs, nrows, xindex);
+ sqz (bzq, bcoeffs, numeigs, nrows, xindex);
+ for (j = 0; j < numeigs; ++j)
+ {
+ if (!regmode)
+ break;
+ apt = azq + j * nrows;
+ bpt = bzq + j * nrows;
+ y = vdot (apt, bpt, nrows) / vdot (apt, apt, nrows);
+ vst (acoeffs + j * numindivs, acoeffs + j * numindivs, y, numindivs);
+ }
- printf("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs") ;
+ for (i = 0; i < numindivs; i++)
+ {
+ indx = indivmarkers[i];
+ if (indx->ignore)
+ continue;
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = acoeffs[j * numindivs + i];
+ fprintf (ofile, "%10.4f ", y);
+ }
+ if (qtmode)
+ {
+ fprintf (ofile, "%15.6e\n", indx->qval);
+ }
+ else
+ {
+ fprintf (ofile, "%15s\n", indx->egroup);
+ }
+ }
- for (j=0; j<numeigs; ++j) {
- y1 = eigkurt[j] ;
- y2 = eigindkurt[j] ;
- printf("%12s %4d %9.3f %9.3f\n", "eigenvector", j+1, y1, y2) ;
- }
+ printf ("%12s %4s %9s %9s\n", "kurtosis", "", "snps", "indivs");
+ for (j = 0; j < numeigs; ++j)
+ {
+ y1 = eigkurt[j];
+ y2 = eigindkurt[j];
+ printf ("%12s %4d %9.3f %9.3f\n", "eigenvector", j + 1, y1, y2);
+ }
// output files
- settersemode(YES) ;
+ settersemode (YES);
- ZALLOC(xpopsize, numeg, int) ;
- for (i = 0; i < numeg; i++) {
- xpopsize[i] = 0;
- }
- for (i=0; i<nrows; i++) {
- k = xtypes[i] ;
- ++xpopsize[k] ;
- }
+ ZALLOC(xpopsize, numeg, int);
+ for (i = 0; i < numeg; i++)
+ {
+ xpopsize[i] = 0;
+ }
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ ++xpopsize[k];
+ }
- for (i=0; i<numeg; i++)
- {
- printf("population: %3d %20s %4d",i, eglist[i], xpopsize[i]) ;
- if (xpopsize[i] == 0) printf(" ***") ;
- printnl() ;
- }
+ for (i = 0; i < numeg; i++)
+ {
+ printf ("population: %3d %20s %4d", i, eglist[i], xpopsize[i]);
+ if (xpopsize[i] == 0)
+ printf (" ***");
+ printnl ();
+ }
+ if (numeg == 1)
+ dotpopsmode = NO;
- if (numeg==1) dotpopsmode = NO ;
+ if (dotpopsmode == NO)
+ {
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ printxcorr (XTX, nrows, xindlist);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- if (dotpopsmode == NO) {
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- printxcorr(XTX, nrows, xindlist) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
+ ZALLOC(chitot, numeg*numeg, double);
- ZALLOC(chitot, numeg*numeg, double) ;
-
- dotpops(XTX, eglist, numeg, xtypes, nrows) ;
- ZALLOC(fstans, numeg*numeg, double) ;
- ZALLOC(fstsd , numeg*numeg, double) ;
-
- setinbreed(inbreed) ;
-
- if (inbreed) {
- ZALLOC(inbans, numeg, double) ;
- ZALLOC(inbsd , numeg, double) ;
- doinbxx(inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers) ;
- printf("## inbreeding coeffs: inbreed std error\n");
- for (k1=0; k1<numeg; ++k1) {
- printf(" %20s %10.4f %10.4f\n", eglist[k1],
- inbans[k1], inbsd[k1]) ;
- }
- free(inbans) ;
- free(inbsd) ;
- }
+ dotpops (XTX, eglist, numeg, xtypes, nrows);
+ ZALLOC(fstans, numeg*numeg, double);
+ ZALLOC(fstsd , numeg*numeg, double);
- dofstxx(fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, blgsize, snpmarkers, indivmarkers);
+ setinbreed (inbreed);
- if ((phylipname == NULL) && (numeg>10)){
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- if (fsthiprec == NO) {
- printf(" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ if (inbreed)
+ {
+ ZALLOC(inbans, numeg, double);
+ ZALLOC(inbsd , numeg, double);
+ doinbxx (inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+ printf ("## inbreeding coeffs: inbreed std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %20s %10.4f %10.4f\n", eglist[k1], inbans[k1], inbsd[k1]);
}
- if (fsthiprec == YES) {
- printf(" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
+ free (inbans);
+ free (inbsd);
+ }
+
+ dofstxx (fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ blgsize, snpmarkers, indivmarkers);
+
+ if ((phylipname == NULL) && (numeg > 10))
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ if (fsthiprec == NO)
+ {
+ printf (" %20s %20s %9.3f %10.4f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ if (fsthiprec == YES)
+ {
+ printf (" %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
+ fstans[k1 * numeg + k2], fstsd[k1 * numeg + k2]);
+ }
+ }
}
- }
+ printf ("\n");
}
- printf("\n");
- }
- if (fstdetailsname != NULL) {
- printf("## Fst statistics between populations: fst std error\n");
- for (k1=0; k1<numeg; ++k1) {
- for (k2=k1+1; k2<numeg; ++k2) {
- fprintf(fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1], eglist[k2],
- fstans[k1*numeg+k2], fstsd[k1*numeg+k2]) ;
- }
+ if (fstdetailsname != NULL)
+ {
+ printf (
+ "## Fst statistics between populations: fst std error\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ fprintf (fstdetails, "F_st %20s %20s %12.6f %12.6f\n", eglist[k1],
+ eglist[k2], fstans[k1 * numeg + k2],
+ fstsd[k1 * numeg + k2]);
+ }
+ }
+ fprintf (fstdetails, "\n");
}
- fprintf(fstdetails, "\n");
- }
-
- if (phylipname != NULL) {
- openit(phylipname, &phylipfile, "w") ;
- fprintf(phylipfile, "%6d\n",numeg) ;
- sss[10] = CNULL ;
- for (k1=0; k1<numeg; ++k1) {
- strncpy(sss, eglist[k1], 10) ;
- fprintf(phylipfile, "%10s", sss) ;
- for (k2=0; k2<numeg; ++k2) {
- y1 = fstans[k1*numeg+k2] ;
- y2 = fstans[k2*numeg+k1] ;
- fprintf(phylipfile, "%6.3f", (0.5*(y1+y2))) ;
- }
- fprintf(phylipfile, "\n") ;
+
+ if (phylipname != NULL)
+ {
+ openit (phylipname, &phylipfile, "w");
+ fprintf (phylipfile, "%6d\n", numeg);
+ sss[10] = CNULL;
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ strncpy (sss, eglist[k1], 10);
+ fprintf (phylipfile, "%10s", sss);
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ y1 = fstans[k1 * numeg + k2];
+ y2 = fstans[k2 * numeg + k1];
+ fprintf (phylipfile, "%6.3f", (0.5 * (y1 + y2)));
+ }
+ fprintf (phylipfile, "\n");
+ }
+ fclose (phylipfile);
}
- fclose(phylipfile) ;
- }
- if ((numeg<=10) || fstonly) {
- if (fsthiprec == NO) {
- printf("fst *1000:") ;
- printnl() ;
- printmatz5(fstans, eglist, numeg) ;
- printnl() ;
+ if ((numeg <= 10) || fstonly)
+ {
+ if (fsthiprec == NO)
+ {
+ printf ("fst *1000:");
+ printnl ();
+ printmatz5 (fstans, eglist, numeg);
+ printnl ();
+ }
+ if (fsthiprec == YES)
+ {
+ printf ("fst *1000000:");
+ printnl ();
+ printmatz10 (fstans, eglist, numeg);
+ printnl ();
+ }
}
- if (fsthiprec == YES) {
- printf("fst *1000000:") ;
- printnl() ;
- printmatz10(fstans, eglist, numeg) ;
- printnl() ;
+ printf ("s.dev * 1000000:\n");
+ vst (fstsd, fstsd, 1000.0, numeg * numeg);
+ printmatz5 (fstsd, eglist, numeg);
+ printnl ();
+ fflush (stdout);
+ if (fstonly)
+ {
+ printf ("##end of smartpca run\n");
+ return 0;
}
- }
- printf("s.dev * 1000000:\n") ;
- vst(fstsd, fstsd, 1000.0, numeg*numeg) ;
- printmatz5(fstsd, eglist, numeg) ;
- printnl() ;
- fflush(stdout) ;
- if (fstonly) {
- printf("##end of smartpca run\n") ;
- return 0 ;
- }
- vst(fstsd, fstsd, 1.0/1000.0, numeg*numeg) ;
-
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "eigenvector %d", j+1) ;
- y=dottest(sss, evecs+j*nrows, eglist, numeg, xtypes, nrows) ;
- }
+ vst (fstsd, fstsd, 1.0 / 1000.0, numeg * numeg);
- printf("\n## Statistical significance of differences beween populations:\n");
- printf(" pop1 pop2 chisq p-value |pop1| |pop2|\n");
- for (k1=0; k1<numeg; ++k1) {
- if (fstonly) break ;
- for (k2=k1+1; k2<numeg; ++k2) {
- ychi = chitot[k1*numeg+k2] ;
- tail = rtlchsq(numeigs, ychi) ;
- printf("popdifference: %20s %20s %12.3f %12.6g", eglist[k1], eglist[k2], ychi, tail) ;
- printf (" %5d", xpopsize[k1]) ;
- printf (" %5d", xpopsize[k2]) ;
- printf("\n") ;
- }
- }
- printf("\n");
- for (i=0; i<ncols; i++) {
- if (markerscore == NO) break;
- cupt = xsnplist[i] ;
- getcolxf(cc, cupt, xindex, nrows, i, NULL, NULL) ;
- sprintf(sss, "%s raw", cupt -> ID) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- for (j=0; j< numeigs; j++) {
- sprintf(sss, "%s subtract sing vec %d", cupt ->ID, j+1) ;
- y = vdot(cc, evecs+j*nrows, nrows) ;
- vst(ww, evecs+j*nrows, y, nrows) ;
- vvm(cc, cc, ww, nrows) ;
- dottest(sss, cc, eglist, numeg, xtypes, nrows) ;
- }
- }
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "eigenvector %d", j + 1);
+ y = dottest (sss, evecs + j * nrows, eglist, numeg, xtypes, nrows);
+ }
- printxcorr(XTX, nrows, xindlist) ;
+ printf ("\n## Statistical significance of differences beween populations:\n");
+ printf (
+ " pop1 pop2 chisq p-value |pop1| |pop2|\n");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ if (fstonly)
+ break;
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ ychi = chitot[k1 * numeg + k2];
+ tail = rtlchsq (numeigs, ychi);
+ printf ("popdifference: %20s %20s %12.3f %12.6g", eglist[k1],
+ eglist[k2], ychi, tail);
+ printf (" %5d", xpopsize[k1]);
+ printf (" %5d", xpopsize[k2]);
+ printf ("\n");
+ }
+ }
+ printf ("\n");
+ for (i = 0; i < ncols; i++)
+ {
+ if (markerscore == NO)
+ break;
+ cupt = xsnplist[i];
+ getcolxf (cc, cupt, xindex, nrows, i, NULL, NULL);
+ sprintf (sss, "%s raw", cupt->ID);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ for (j = 0; j < numeigs; j++)
+ {
+ sprintf (sss, "%s subtract sing vec %d", cupt->ID, j + 1);
+ y = vdot (cc, evecs + j * nrows, nrows);
+ vst (ww, evecs + j * nrows, y, nrows);
+ vvm (cc, cc, ww, nrows);
+ dottest (sss, cc, eglist, numeg, xtypes, nrows);
+ }
+ }
+ printxcorr (XTX, nrows, xindlist);
- writesnpeigs(snpeigname, xsnplist, ffvecs, numeigs, ncols) ;
- if (snpoutfilename != NULL) {
- outfiles(snpoutfilename, indoutfilename, genooutfilename,
- snpmarkers, indivmarkers, numsnps, numindivs, packout, ogmode) ;
- }
+ writesnpeigs (snpeigname, xsnplist, ffvecs, numeigs, ncols);
+ if (snpoutfilename != NULL)
+ {
+ outfiles (snpoutfilename, indoutfilename, genooutfilename, snpmarkers,
+ indivmarkers, numsnps, numindivs, packout, ogmode);
+ }
- printf("##end of smartpca run\n") ;
- return 0 ;
+ printf ("##end of smartpca run\n");
+ return 0;
}
-void readcommands(int argc, char **argv)
+void
+readcommands (int argc, char **argv)
{
- int i ;
- phandle *ph ;
- int t ;
+ int i;
+ phandle *ph;
+ int t;
- while ((i = getopt (argc, argv, "p:vV")) != -1) {
+ while ((i = getopt (argc, argv, "p:vV")) != -1)
+ {
- switch (i)
- {
+ switch (i)
+ {
- case 'p':
- parname = strdup(optarg) ;
- break;
+ case 'p':
+ parname = strdup (optarg);
+ break;
- case 'v':
- printf("version: %s\n", WVERSION) ;
- break;
+ case 'v':
+ printf ("version: %s\n", WVERSION);
+ break;
- case 'V':
- verbose = YES ;
- break;
+ case 'V':
+ verbose = YES;
+ break;
- case '?':
- printf ("Usage: bad params.... \n") ;
- fatalx("bad params\n") ;
- }
- }
+ case '?':
+ printf ("Usage: bad params.... \n");
+ fatalx ("bad params\n");
+ }
+ }
-
- if (parname==NULL) {
- fprintf(stderr, "no parameters\n") ;
- return ;
- }
+ if (parname == NULL)
+ {
+ fprintf (stderr, "no parameters\n");
+ return;
+ }
- pcheck(parname,'p') ;
- printf("parameter file: %s\n", parname) ;
- ph = openpars(parname) ;
- dostrsub(ph) ;
-
- getstring(ph, "genotypename:", &genotypename) ;
- getstring(ph, "snpname:", &snpname) ;
- getstring(ph, "indivname:", &indivname) ;
- getstring(ph, "poplistname:", &poplistname) ;
- getstring(ph, "snpeigname:", &snpeigname) ;
- getstring(ph, "snpweightoutname:", &snpeigname) ; /* changed 09/18/07 */
- getstring(ph, "output:", &outputname) ;
- getstring(ph, "outputvecs:", &outputname) ;
- getstring(ph, "evecoutname:", &outputname) ; /* changed 11/02/06 */
- getstring(ph, "outputvals:", &outputvname) ;
- getstring(ph, "evaloutname:", &outputvname) ; /* changed 11/02/06 */
- getstring(ph, "badsnpname:", &badsnpname) ;
- getstring(ph, "outliername:", &outliername) ;
- getstring(ph, "outlieroutname:", &outliername) ; /* changed 11/02/06 */
- getstring(ph, "phylipname:", &phylipname) ;
- getstring(ph, "phylipoutname:", &phylipname) ; /* changed 11/02/06 */
- getstring(ph, "weightname:", &weightname) ;
- getstring(ph, "fstdetailsname:", &fstdetailsname) ;
- getstring(ph, "deletsnpoutname:", &deletesnpoutname) ;
- getint(ph, "numeigs:", &numeigs) ;
- getint(ph, "maxpops:", &maxpops) ; maxpops = MIN(maxpops, MAXPOPS) ;
- getint(ph, "numoutevec:", &numeigs) ; /* changed 11/02/06 */
- getint(ph, "markerscore:", &markerscore) ;
- getint(ph, "chisqmode:", &chisqmode) ;
- getint(ph, "missingmode:", &missingmode) ;
- getint(ph, "shrinkmode:", &shrinkmode) ;
- getint(ph, "fancynorm:", &fancynorm) ;
- getint(ph, "usenorm:", &fancynorm) ; /* changed 11/02/06 */
- getint(ph, "dotpopsmode:", &dotpopsmode) ;
- getint(ph, "pcorrmode:", &pcorrmode) ; /* print correlations */
- getint(ph, "pcpopsonly:", &pcpopsonly) ; /* but only within population */
- getint(ph, "altnormstyle:", &altnormstyle) ;
- getint(ph, "hashcheck:", &hashcheck) ;
- getint(ph, "popgenmode:", &altnormstyle) ;
- getint(ph, "noxdata:", &noxdata) ;
- getint(ph, "inbreed:", &inbreed) ;
- getint(ph, "easymode:", &easymode) ;
- getint(ph, "fastmode:", &fastmode) ;
- getint(ph, "usepopsformissing:", &usepopsformissing) ;
- getint(ph, "regmode:", ®mode) ;
- getint(ph, "lsqproject:", ®mode) ;
-
- t = -1 ;
- getint(ph, "xdata:", &t) ; if (t>=0) noxdata = 1-t ;
- getint(ph, "nostatslim:", &nostatslim) ;
- getint(ph, "popsizelimit:", &popsizelimit) ;
- getint(ph, "minallelecnt:", &minallelecnt) ;
- getint(ph, "chrom:", &xchrom) ;
- getint(ph, "maxmissing:", &maxmissing) ;
- getint(ph, "lopos:", &lopos) ;
- getint(ph, "hipos:", &hipos) ;
- getint(ph, "checksizemode:", &checksizemode) ;
- getint(ph, "pubmean:", &pubmean) ;
- getint(ph, "fstonly:", &fstonly) ;
- getint(ph, "fsthiprecision:", &fsthiprec) ;
-
- getint(ph, "ldregress:", &ldregress) ;
- getint(ph, "nsnpldregress:", &ldregress) ; /* changed 11/02/06 */
- getdbl(ph, "ldlimit:", &ldlimit) ; /* in morgans */
- getint(ph, "ldposlimit:", &ldposlimit) ; /* bases */
- getdbl(ph, "ldr2lo:", &ldr2lo) ;
- getdbl(ph, "ldr2hi:", &ldr2hi) ;
- getdbl(ph, "maxdistldregress:", &ldlimit) ; /* in morgans */ /* changed 11/02/06 */
- getint(ph, "minleneig:", &nostatslim) ;
- getint(ph, "malexhet:", &malexhet) ;
- getint(ph, "nomalexhet:", &malexhet) ; /* changed 11/02/06 */
- getint(ph, "familynames:", &familynames) ;
- getint(ph, "qtmode:", &qtmode) ;
-
- getint(ph, "numoutliter:", &numoutliter) ;
- getint(ph, "numoutlieriter:", &numoutliter) ; /* changed 11/02/06 */
- getint(ph, "numoutleigs", &numoutleigs) ;
- getint(ph, "numoutlierevec:", &numoutleigs) ; /* changed 11/02/06 */
- getdbl(ph, "outlthresh:", &outlthresh) ;
- getdbl(ph, "outliersigmathresh:", &outlthresh) ; /* changed 11/02/06 */
- getint(ph, "outliermode:", &outliermode) ; /* test distribution with sample removed. Makes sense for small samples */
- getdbl(ph, "blgsize:", &blgsize) ;
-
- getstring(ph, "indoutfilename:", &indoutfilename) ;
- getstring(ph, "indivoutname:", &indoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "snpoutfilename:", &snpoutfilename) ;
- getstring(ph, "snpoutname:", &snpoutfilename) ; /* changed 11/02/06 */
- getstring(ph, "genooutfilename:", &genooutfilename) ;
- getstring(ph, "genotypeoutname:", &genooutfilename) ; /* changed 11/02/06 */
- getstring(ph, "outputformat:", &omode) ;
- getstring(ph, "outputmode:", &omode) ;
- getint(ph, "outputgroup:", &ogmode) ;
- getstring(ph, "grmoutname:", &grmoutname) ;
- getint(ph, "grmbinary:", &grmbinary) ;
- getint(ph, "packout:", &packout) ; /* now obsolete 11/02/06 */
- getstring(ph, "twxtabname:", &twxtabname) ;
- getstring(ph, "id2pops:", &id2pops) ;
-
- getdbl(ph, "r2thresh:", &r2thresh) ;
- getdbl(ph, "r2genlim:", &r2genlim) ;
- getdbl(ph, "r2physlim:", &r2physlim) ;
- getint(ph, "killr2:", &killr2) ;
-
- getint(ph, "numchrom:", &numchrom) ;
- getstring(ph, "xregionname:", &xregionname) ;
- getdbl(ph, "hwfilter:", &nhwfilter) ;
-
- getint(ph, "numthreads:", &thread_ct_config) ;
-
- printf("### THE INPUT PARAMETERS\n");
- printf("##PARAMETER NAME: VALUE\n");
- writepars(ph);
+ pcheck (parname, 'p');
+ printf ("parameter file: %s\n", parname);
+ ph = openpars (parname);
+ dostrsub (ph);
+
+ getstring (ph, "genotypename:", &genotypename);
+ getstring (ph, "snpname:", &snpname);
+ getstring (ph, "indivname:", &indivname);
+ getstring (ph, "poplistname:", &poplistname);
+ getstring (ph, "snpeigname:", &snpeigname);
+ getstring (ph, "snpweightoutname:", &snpeigname); /* changed 09/18/07 */
+ getstring (ph, "output:", &outputname);
+ getstring (ph, "outputvecs:", &outputname);
+ getstring (ph, "evecoutname:", &outputname); /* changed 11/02/06 */
+ getstring (ph, "outputvals:", &outputvname);
+ getstring (ph, "evaloutname:", &outputvname); /* changed 11/02/06 */
+ getstring (ph, "badsnpname:", &badsnpname);
+ getstring (ph, "outliername:", &outliername);
+ getstring (ph, "outlieroutname:", &outliername); /* changed 11/02/06 */
+ getstring (ph, "phylipname:", &phylipname);
+ getstring (ph, "phylipoutname:", &phylipname); /* changed 11/02/06 */
+ getstring (ph, "weightname:", &weightname);
+ getstring (ph, "fstdetailsname:", &fstdetailsname);
+ getstring (ph, "deletsnpoutname:", &deletesnpoutname);
+ getint (ph, "numeigs:", &numeigs);
+ getint (ph, "maxpops:", &maxpops);
+ maxpops = MIN(maxpops, MAXPOPS);
+ getint (ph, "numoutevec:", &numeigs); /* changed 11/02/06 */
+ getint (ph, "markerscore:", &markerscore);
+ getint (ph, "chisqmode:", &chisqmode);
+ getint (ph, "missingmode:", &missingmode);
+ getint (ph, "shrinkmode:", &shrinkmode);
+ getint (ph, "fancynorm:", &fancynorm);
+ getint (ph, "usenorm:", &fancynorm); /* changed 11/02/06 */
+ getint (ph, "dotpopsmode:", &dotpopsmode);
+ getint (ph, "pcorrmode:", &pcorrmode); /* print correlations */
+ getint (ph, "pcpopsonly:", &pcpopsonly); /* but only within population */
+ getint (ph, "altnormstyle:", &altnormstyle);
+ getint (ph, "hashcheck:", &hashcheck);
+ getint (ph, "popgenmode:", &altnormstyle);
+ getint (ph, "noxdata:", &noxdata);
+ getint (ph, "inbreed:", &inbreed);
+ getint (ph, "easymode:", &easymode);
+ getint (ph, "fastmode:", &fastmode);
+ getint (ph, "usepopsformissing:", &usepopsformissing);
+ getint (ph, "regmode:", ®mode);
+ getint (ph, "lsqproject:", ®mode);
+
+ t = -1;
+ getint (ph, "xdata:", &t);
+ if (t >= 0)
+ noxdata = 1 - t;
+ getint (ph, "nostatslim:", &nostatslim);
+ getint (ph, "popsizelimit:", &popsizelimit);
+ getint (ph, "minallelecnt:", &minallelecnt);
+ getint (ph, "chrom:", &xchrom);
+ getint (ph, "maxmissing:", &maxmissing);
+ getint (ph, "lopos:", &lopos);
+ getint (ph, "hipos:", &hipos);
+ getint (ph, "checksizemode:", &checksizemode);
+ getint (ph, "pubmean:", &pubmean);
+ getint (ph, "fstonly:", &fstonly);
+ getint (ph, "fsthiprecision:", &fsthiprec);
+
+ getint (ph, "ldregress:", &ldregress);
+ getint (ph, "nsnpldregress:", &ldregress); /* changed 11/02/06 */
+ getdbl (ph, "ldlimit:", &ldlimit); /* in morgans */
+ getint (ph, "ldposlimit:", &ldposlimit); /* bases */
+ getdbl (ph, "ldr2lo:", &ldr2lo);
+ getdbl (ph, "ldr2hi:", &ldr2hi);
+ getdbl (ph, "maxdistldregress:", &ldlimit); /* in morgans *//* changed 11/02/06 */
+ getint (ph, "minleneig:", &nostatslim);
+ getint (ph, "malexhet:", &malexhet);
+ getint (ph, "nomalexhet:", &malexhet); /* changed 11/02/06 */
+ getint (ph, "familynames:", &familynames);
+ getint (ph, "qtmode:", &qtmode);
+
+ getint (ph, "numoutliter:", &numoutliter);
+ getint (ph, "numoutlieriter:", &numoutliter); /* changed 11/02/06 */
+ getint (ph, "numoutleigs", &numoutleigs);
+ getint (ph, "numoutlierevec:", &numoutleigs); /* changed 11/02/06 */
+ getdbl (ph, "outlthresh:", &outlthresh);
+ getdbl (ph, "outliersigmathresh:", &outlthresh); /* changed 11/02/06 */
+ getint (ph, "outliermode:", &outliermode); /* test distribution with sample removed. Makes sense for small samples */
+ getdbl (ph, "blgsize:", &blgsize);
+
+ getstring (ph, "indoutfilename:", &indoutfilename);
+ getstring (ph, "indivoutname:", &indoutfilename); /* changed 11/02/06 */
+ getstring (ph, "snpoutfilename:", &snpoutfilename);
+ getstring (ph, "snpoutname:", &snpoutfilename); /* changed 11/02/06 */
+ getstring (ph, "genooutfilename:", &genooutfilename);
+ getstring (ph, "genotypeoutname:", &genooutfilename); /* changed 11/02/06 */
+ getstring (ph, "outputformat:", &omode);
+ getstring (ph, "outputmode:", &omode);
+ getint (ph, "outputgroup:", &ogmode);
+ getstring (ph, "grmoutname:", &grmoutname);
+ getint (ph, "grmbinary:", &grmbinary);
+ getint (ph, "packout:", &packout); /* now obsolete 11/02/06 */
+ getstring (ph, "twxtabname:", &twxtabname);
+ getstring (ph, "id2pops:", &id2pops);
+
+ getdbl (ph, "r2thresh:", &r2thresh);
+ getdbl (ph, "r2genlim:", &r2genlim);
+ getdbl (ph, "r2physlim:", &r2physlim);
+ getint (ph, "killr2:", &killr2);
+
+ getint (ph, "numchrom:", &numchrom);
+ getstring (ph, "xregionname:", &xregionname);
+ getdbl (ph, "hwfilter:", &nhwfilter);
+
+ getint (ph, "numthreads:", &thread_ct_config);
+
+ printf ("### THE INPUT PARAMETERS\n");
+ printf ("##PARAMETER NAME: VALUE\n");
+ writepars (ph);
}
-int fvadjust(double *cc, int n, double *pmean, double *fancy)
+int
+fvadjust (double *cc, int n, double *pmean, double *fancy)
/* take off mean force missing to zero */
/* set up fancy norming */
{
- double p, ynum, ysum, y, ymean, yfancy = 1.0 ;
- int i, nmiss=0 ;
-
- ynum = ysum = 0.0 ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) {
- ++nmiss ;
- continue ;
- }
- ++ynum ;
- ysum += y ;
- }
- if (ynum==0.0) {
- return -999 ;
- }
- ymean = ysum/ynum ;
- for (i=0; i<n; i++) {
- y = cc[i] ;
- if (y < 0.0) cc[i] = 0.0 ;
- else cc[i] -= ymean ;
- }
- if (pmean != NULL) *pmean = ymean ;
- if (fancynorm) {
- p = 0.5*ymean ; // autosomes
- if (altnormstyle == NO) p = (ysum+1.0)/(2.0*ynum+2.0) ;
- y = p * (1.0-p) ;
- if (y>0.0) yfancy = 1.0/sqrt(y) ;
- }
- if (fancy != NULL) *fancy = yfancy ;
- return nmiss ;
+ double p, ynum, ysum, y, ymean, yfancy = 1.0;
+ int i, nmiss = 0;
+
+ ynum = ysum = 0.0;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ {
+ ++nmiss;
+ continue;
+ }
+ ++ynum;
+ ysum += y;
+ }
+ if (ynum == 0.0)
+ {
+ return -999;
+ }
+ ymean = ysum / ynum;
+ for (i = 0; i < n; i++)
+ {
+ y = cc[i];
+ if (y < 0.0)
+ cc[i] = 0.0;
+ else
+ cc[i] -= ymean;
+ }
+ if (pmean != NULL)
+ *pmean = ymean;
+ if (fancynorm)
+ {
+ p = 0.5 * ymean; // autosomes
+ if (altnormstyle == NO)
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ yfancy = 1.0 / sqrt (y);
+ }
+ if (fancy != NULL)
+ *fancy = yfancy;
+ return nmiss;
}
-int fvadjust_binary(int c0, int c1, int nmiss, int n, double* cc, double* pmean, double* fancy)
+int
+fvadjust_binary (int c0, int c1, int nmiss, int n, double* cc, double* pmean,
+ double* fancy)
{
double p, ynum, ysum, y, ymean, yfancy = 1.0;
- if (n == nmiss) {
- return -999;
- }
+ if (n == nmiss)
+ {
+ return -999;
+ }
ynum = n - nmiss;
ysum = c0;
ymean = ysum / ynum;
cc[0] = -ymean;
cc[1] = 1.0 - ymean;
cc[2] = 2.0 - ymean;
- if (fancynorm) {
- p = 0.5*ymean;
- if (altnormstyle == NO) {
- p = (ysum+1.0)/(2.0*ynum+2.0);
+ if (fancynorm)
+ {
+ p = 0.5 * ymean;
+ if (altnormstyle == NO)
+ {
+ p = (ysum + 1.0) / (2.0 * ynum + 2.0);
+ }
+ y = p * (1.0 - p);
+ if (y > 0.0)
+ {
+ yfancy = 1.0 / sqrt (y);
+ }
}
- y = p * (1.0-p);
- if (y>0.0) {
- yfancy = 1.0/sqrt(y);
+ if (pmean)
+ {
+ *pmean = ymean;
+ }
+ if (fancy)
+ {
+ *fancy = yfancy;
}
- }
- if (pmean) {
- *pmean = ymean;
- }
- if (fancy) {
- *fancy = yfancy;
- }
return nmiss;
}
double
-dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
+dottest (char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len)
// vec will always have mean 0
// perhaps should rewrite to put xa1 etc in arrays
{
- double *w1 ;
- int *xt ;
- int i, k1, k2, k, n, x1, x2 ;
- double ylike ;
- double ychi ;
- double *wmean ;
- int imax, imin, *isort ;
- static int ncall = 0 ;
-
- char ss1[MAXSTR] ;
- char ss2[MAXSTR] ;
- double ans, ftail, ftailx, ansx ;
-
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(w1, len + numeg, double) ;
- ZALLOC(isort, numeg, int) ;
- ZALLOC(xt, len, int) ;
- strcpy(ss1, "") ;
-
- calcmean(wmean, vec, len, xtypes, numeg) ;
- if (pubmean) {
- copyarr(wmean, w1, numeg) ;
- sortit(w1, isort, numeg) ;
- printf("%s:means\n", sss) ;
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- printf("%20s ", eglist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ double *w1;
+ int *xt;
+ int i, k1, k2, k, n, x1, x2;
+ double ylike;
+ double ychi;
+ double *wmean;
+ int imax, imin, *isort;
+ static int ncall = 0;
+
+ char ss1[MAXSTR];
+ char ss2[MAXSTR];
+ double ans, ftail, ftailx, ansx;
+
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(w1, len + numeg, double);
+ ZALLOC(isort, numeg, int);
+ ZALLOC(xt, len, int);
+ strcpy (ss1, "");
+
+ calcmean (wmean, vec, len, xtypes, numeg);
+ if (pubmean)
+ {
+ copyarr (wmean, w1, numeg);
+ sortit (w1, isort, numeg);
+ printf ("%s:means\n", sss);
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ printf ("%20s ", eglist[k]);
+ printf (" %9.3f\n", wmean[k]);
+ }
}
- }
- vlmaxmin(wmean, numeg, &imax, &imin) ;
- if (chisqmode) {
- ylike = anova1(vec, len, xtypes, numeg) ;
- ans = 2.0*ylike ;
+ vlmaxmin (wmean, numeg, &imax, &imin);
+ if (chisqmode)
+ {
+ ylike = anova1 (vec, len, xtypes, numeg);
+ ans = 2.0 * ylike;
}
- else {
- ans = ftail = anova(vec, len, xtypes, numeg) ;
+ else
+ {
+ ans = ftail = anova (vec, len, xtypes, numeg);
}
- ++ncall ;
+ ++ncall;
-
- if (numeg>2) {
- sprintf(ss2, "%s %s ", sss, "overall") ;
- publishit(ss2, numeg-1, ans) ;
- printf(" %20s minv: %9.3f %20s maxv: %9.3f\n",
- eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ;
+ if (numeg > 2)
+ {
+ sprintf (ss2, "%s %s ", sss, "overall");
+ publishit (ss2, numeg - 1, ans);
+ printf (" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin],
+ eglist[imax], wmean[imax]);
}
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < numeg; ++k2)
+ {
+ n = 0;
+ x1 = x2 = 0;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ if (k == k1)
+ {
+ w1[n] = vec[i];
+ xt[n] = 0;
+ ++n;
+ ++x1;
+ }
+ if (k == k2)
+ {
+ w1[n] = vec[i];
+ xt[n] = 1;
+ ++n;
+ ++x2;
+ }
+ }
+
+ if (x1 <= 1)
+ continue;
+ if (x2 <= 1)
+ continue;
+
+ ylike = anova1 (w1, n, xt, 2);
+ ychi = 2.0 * ylike;
+ chitot[k1 * numeg + k2] += ychi;
+ if (chisqmode)
+ {
+ ansx = ychi;
+ }
+ else
+ {
+ ansx = ftailx = anova (w1, n, xt, 2);
+ }
+
+ sprintf (ss2, "%s %s %s ", sss, eglist[k1], eglist[k2]);
+ publishit (ss2, 1, ansx);
- for (k1 = 0; k1<numeg; ++k1) {
- for (k2 = k1+1; k2<numeg; ++k2) {
- n = 0 ;
- x1 = x2 = 0 ;
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- if (k == k1) {
- w1[n] = vec[i] ;
- xt[n] = 0 ;
- ++n ;
- ++x1 ;
- }
- if (k == k2) {
- w1[n] = vec[i] ;
- xt[n] = 1 ;
- ++n ;
- ++x2 ;
}
- }
-
- if (x1 <= 1) continue ;
- if (x2 <= 1) continue ;
-
- ylike = anova1(w1, n, xt, 2) ;
- ychi = 2.0*ylike ;
- chitot[k1*numeg + k2] += ychi ;
- if (chisqmode) {
- ansx = ychi ;
- }
- else {
- ansx = ftailx = anova(w1, n, xt, 2) ;
- }
-
- sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ;
- publishit(ss2, 1, ansx) ;
-
- }
- }
- free(w1) ;
- free(xt) ;
- free(wmean) ;
- free(isort) ;
- return ans ;
+ }
+ free (w1);
+ free (xt);
+ free (wmean);
+ free (isort);
+ return ans;
}
-double anova(double *vec, int len, int *xtypes, int numeg)
+double
+anova (double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
- int i, k ;
- double y1, top, bot, ftail ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, top, bot, ftail;
+ double *w0, *w1, *popsize, *wmean;
- static int ncall2 = 0 ;
+ static int ncall2 = 0;
- if (numeg >= len) {
- printf("*** warning: bad anova popsizes too small\n") ;
- return 0.0 ;
- }
+ if (numeg >= len)
+ {
+ printf ("*** warning: bad anova popsizes too small\n");
+ return 0.0;
+ }
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
-/* debug */
- if (numeg == 2) {
- ++ncall2 ;
- for (i=0; i<len; ++i) {
- if (ncall2<0) break ;
- k = xtypes[i] ;
+ /* debug */
+ if (numeg == 2)
+ {
+ ++ncall2;
+ for (i = 0; i < len; ++i)
+ {
+ if (ncall2 < 0)
+ break;
+ k = xtypes[i];
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
- }
+ }
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
- vvt(w1, wmean, wmean, numeg) ;
- top = vdot(w1, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vvt (w1, wmean, wmean, numeg);
+ top = vdot (w1, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- bot = asum2(w1, len) / (double) (len-numeg) ;
- bot *= (double) (numeg-1) ;
- ftail = rtlf(numeg-1, len-numeg, top/bot) ;
+ bot = asum2 (w1, len) / (double) (len - numeg);
+ bot *= (double) (numeg - 1);
+ ftail = rtlf (numeg - 1, len - numeg, top / bot);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ftail ;
+ return ftail;
}
-double anova1(double *vec, int len, int *xtypes, int numeg)
+double
+anova1 (double *vec, int len, int *xtypes, int numeg)
{
- int i, k ;
- double y1, y2, ylike ;
- double *w0, *w1, *popsize, *wmean ;
+ int i, k;
+ double y1, y2, ylike;
+ double *w0, *w1, *popsize, *wmean;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(popsize, numeg, double) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(wmean, numeg, double);
+ ZALLOC(popsize, numeg, double);
- y1 = asum(vec, len)/ (double) len ; // mean
- vsp(w0, vec, -y1, len) ;
+ y1 = asum (vec, len) / (double) len; // mean
+ vsp (w0, vec, -y1, len);
- for (i=0; i<len; i++) {
- k = xtypes[i] ;
- ++popsize[k] ;
- wmean[k] += w0[i] ;
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ ++popsize[k];
+ wmean[k] += w0[i];
}
- vsp(popsize, popsize, 1.0e-12, numeg) ;
- vvd(wmean, wmean, popsize, numeg) ;
-
- for (i=0; i<len ; i++) {
- k = xtypes[i] ;
- w1[i] = w0[i] - wmean[k] ;
+ vsp (popsize, popsize, 1.0e-12, numeg);
+ vvd (wmean, wmean, popsize, numeg);
+
+ for (i = 0; i < len; i++)
+ {
+ k = xtypes[i];
+ w1[i] = w0[i] - wmean[k];
}
- y1 = asum2(w0, len) / (double) len ;
- y2 = asum2(w1, len) / (double) len ;
- ylike = 0.5*((double) len)*log(y1/y2) ;
+ y1 = asum2 (w0, len) / (double) len;
+ y2 = asum2 (w1, len) / (double) len;
+ ylike = 0.5 * ((double) len) * log (y1 / y2);
- free(w0) ;
- free(w1) ;
- free(popsize) ;
- free(wmean) ;
+ free (w0);
+ free (w1);
+ free (popsize);
+ free (wmean);
- return ylike ;
+ return ylike;
}
-void publishit(char *sss, int df, double chi)
+void
+publishit (char *sss, int df, double chi)
{
- double tail ;
- char sshit[4] ;
- char ss2[MAXSTR] ;
- int i, n ;
- char cblank, cunder ;
- static int ncall = 0 ;
-
- ++ncall ;
- cblank = ' ' ;
- cunder = '_' ;
- n = strlen(sss) ;
-
- strcpy(ss2, sss) ;
- for (i=0; i< n; ++i) {
- if (ss2[i] == cblank) ss2[i] = cunder ;
- }
+ double tail;
+ char sshit[4];
+ char ss2[MAXSTR];
+ int i, n;
+ char cblank, cunder;
+ static int ncall = 0;
+
+ ++ncall;
+ cblank = ' ';
+ cunder = '_';
+ n = strlen (sss);
+
+ strcpy (ss2, sss);
+ for (i = 0; i < n; ++i)
+ {
+ if (ss2[i] == cblank)
+ ss2[i] = cunder;
+ }
- if (chisqmode) {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value") ;
- printf("%40s %6d %9.3f",ss2, df, chi) ;
- tail = rtlchsq(df, chi) ;
- printf(" %12.6g", tail) ;
- }
- else {
- if (ncall==1) printf("## Anova statistics for population differences along each eigenvector:\n");
- if (ncall==1) printf("%40s %12s\n", "", "p-value") ;
- printf("%40s ", ss2) ;
- tail = chi ;
- printf(" %12.6g", tail) ;
- }
- strcpy(sshit, "") ;
- if (tail < pvhit) strcpy(sshit, "***") ;
- if (tail < pvjack) strcpy(sshit, "+++") ;
- printf(" %s", sshit) ;
- printf("\n") ;
+ if (chisqmode)
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %6s %9s %12s\n", "", "dof", "chisq", "p-value");
+ printf ("%40s %6d %9.3f", ss2, df, chi);
+ tail = rtlchsq (df, chi);
+ printf (" %12.6g", tail);
+ }
+ else
+ {
+ if (ncall == 1)
+ printf (
+ "## Anova statistics for population differences along each eigenvector:\n");
+ if (ncall == 1)
+ printf ("%40s %12s\n", "", "p-value");
+ printf ("%40s ", ss2);
+ tail = chi;
+ printf (" %12.6g", tail);
+ }
+ strcpy (sshit, "");
+ if (tail < pvhit)
+ strcpy (sshit, "***");
+ if (tail < pvjack)
+ strcpy (sshit, "+++");
+ printf (" %s", sshit);
+ printf ("\n");
}
void
-dotpops(double *X, char **eglist, int numeg, int *xtypes, int nrows)
+dotpops (double *X, char **eglist, int numeg, int *xtypes, int nrows)
{
- double *pp, *npp, val, yy ;
- int *popsize ;
- int i, j, k1, k2 ;
-
-
- if (fstonly) return ;
- ZALLOC(pp, numeg * numeg, double) ;
- ZALLOC(npp, numeg * numeg, double) ;
- popsize = xpopsize;
-
- ivzero(popsize, numeg) ;
-
- for (i=0; i<nrows; i++) {
- k1 = xtypes[i] ;
- ++popsize[k1] ;
- for (j=i+1; j<nrows; j++) {
- k2 = xtypes[j] ;
- if (k1 < 0) fatalx("bug\n") ;
- if (k2 < 0) fatalx("bug\n") ;
- if (k1>=numeg) fatalx("bug\n") ;
- if (k2>=numeg) fatalx("bug\n") ;
- val = X[i*nrows+i] + X[j*nrows+j] - 2.0*X[i*nrows+j] ;
- pp[k1*numeg+k2] += val ;
- pp[k2*numeg+k1] += val ;
- ++npp[k1*numeg+k2] ;
- ++npp[k2*numeg+k1] ;
- }
- }
- vsp(npp, npp, 1.0e-8, numeg*numeg) ;
- vvd(pp, pp, npp, numeg*numeg) ;
+ double *pp, *npp, val, yy;
+ int *popsize;
+ int i, j, k1, k2;
+
+ if (fstonly)
+ return;
+ ZALLOC(pp, numeg * numeg, double);
+ ZALLOC(npp, numeg * numeg, double);
+ popsize = xpopsize;
+
+ ivzero (popsize, numeg);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k1 = xtypes[i];
+ ++popsize[k1];
+ for (j = i + 1; j < nrows; j++)
+ {
+ k2 = xtypes[j];
+ if (k1 < 0)
+ fatalx ("bug\n");
+ if (k2 < 0)
+ fatalx ("bug\n");
+ if (k1 >= numeg)
+ fatalx ("bug\n");
+ if (k2 >= numeg)
+ fatalx ("bug\n");
+ val = X[i * nrows + i] + X[j * nrows + j] - 2.0 * X[i * nrows + j];
+ pp[k1 * numeg + k2] += val;
+ pp[k2 * numeg + k1] += val;
+ ++npp[k1 * numeg + k2];
+ ++npp[k2 * numeg + k1];
+ }
+ }
+ vsp (npp, npp, 1.0e-8, numeg * numeg);
+ vvd (pp, pp, npp, numeg * numeg);
// and normalize so that mean on diagonal is 1
- yy = trace(pp, numeg) / (double) numeg ;
- vst(pp, pp, 1.0/yy, numeg*numeg) ;
- printf("\n## Average divergence between populations:");
- if (numeg<=10) {
- printf("\n") ;
- printf("%10s", "") ;
- for (k1=0; k1<numeg; ++k1) {
- printf(" %10s", eglist[k1]) ;
- }
- printf(" %10s", "popsize") ;
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- printf("%10s", eglist[k2]) ;
- for (k1=0; k1<numeg; ++k1) {
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- };
- printf(" %10d", popsize[k2]) ;
- printf("\n") ;
- }
- }
- else { // numeg >= 10
- printf("\n") ;
- for (k2=0; k2<numeg; ++k2) {
- for (k1=k2; k1<numeg; ++k1) {
- printf("dotp: %10s", eglist[k2]) ;
- printf(" %10s", eglist[k1]) ;
- val = pp[k1*numeg+k2] ;
- printf(" %10.3f", val) ;
- printf(" %10d", popsize[k2]) ;
- printf(" %10d", popsize[k1]) ;
- printf("\n") ;
- }
- }
- }
- printf("\n") ;
- printf("\n") ;
- fflush(stdout) ;
-
+ yy = trace (pp, numeg) / (double) numeg;
+ vst (pp, pp, 1.0 / yy, numeg * numeg);
+ printf ("\n## Average divergence between populations:");
+ if (numeg <= 10)
+ {
+ printf ("\n");
+ printf ("%10s", "");
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ printf (" %10s", eglist[k1]);
+ }
+ printf (" %10s", "popsize");
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ printf ("%10s", eglist[k2]);
+ for (k1 = 0; k1 < numeg; ++k1)
+ {
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ };
+ printf (" %10d", popsize[k2]);
+ printf ("\n");
+ }
+ }
+ else
+ { // numeg >= 10
+ printf ("\n");
+ for (k2 = 0; k2 < numeg; ++k2)
+ {
+ for (k1 = k2; k1 < numeg; ++k1)
+ {
+ printf ("dotp: %10s", eglist[k2]);
+ printf (" %10s", eglist[k1]);
+ val = pp[k1 * numeg + k2];
+ printf (" %10.3f", val);
+ printf (" %10d", popsize[k2]);
+ printf (" %10d", popsize[k1]);
+ printf ("\n");
+ }
+ }
+ }
+ printf ("\n");
+ printf ("\n");
+ fflush (stdout);
- free(pp) ;
- free(npp) ;
+ free (pp);
+ free (npp);
}
-void printxcorr(double *X, int nrows, Indiv **indxx)
+void
+printxcorr (double *X, int nrows, Indiv **indxx)
{
- int k1, k2, t ;
- double y1, y2, yy, rho ;
- Indiv *ind1, *ind2 ;
+ int k1, k2, t;
+ double y1, y2, yy, rho;
+ Indiv *ind1, *ind2;
- if (pcorrmode == NO) return ;
- for (k1=0; k1<nrows; ++k1) {
- for (k2=k1+1; k2<nrows; ++k2) {
+ if (pcorrmode == NO)
+ return;
+ for (k1 = 0; k1 < nrows; ++k1)
+ {
+ for (k2 = k1 + 1; k2 < nrows; ++k2)
+ {
- ind1 = indxx[k1] ;
- ind2 = indxx[k2] ;
+ ind1 = indxx[k1];
+ ind2 = indxx[k2];
- t = strcmp(ind1 -> egroup, ind2 -> egroup) ;
- if (pcpopsonly && (t != 0)) continue ;
-
+ t = strcmp (ind1->egroup, ind2->egroup);
+ if (pcpopsonly && (t != 0))
+ continue;
- y1 = X[k1*nrows+k1] ;
- y2 = X[k2*nrows+k2] ;
- yy = X[k1*nrows+k2] ;
+ y1 = X[k1 * nrows + k1];
+ y2 = X[k2 * nrows + k2];
+ yy = X[k1 * nrows + k2];
- rho = yy/sqrt(y1*y2+1.0e-20) ;
- printf("corr: %20s %20s %20s %20s %9.3f\n",
- ind1 -> ID, ind2 -> ID, ind1 -> egroup, ind2 -> egroup, rho) ;
+ rho = yy / sqrt (y1 * y2 + 1.0e-20);
+ printf ("corr: %20s %20s %20s %20s %9.3f\n", ind1->ID, ind2->ID,
+ ind1->egroup, ind2->egroup, rho);
+ }
}
- }
}
-void bumpldvv(double *gsource, double *newsource, int *pnumld, int maxld, int n, int *ldsnpbuff, int newsnpnum)
+void
+bumpldvv (double *gsource, double *newsource, int *pnumld, int maxld, int n,
+ int *ldsnpbuff, int newsnpnum)
{
- int numld ;
- SNP *cuptnew, *cuptold ;
- int pdiff ;
- double gdiff ;
-
+ int numld;
+ SNP *cuptnew, *cuptold;
+ int pdiff;
+ double gdiff;
- numld = *pnumld ;
-
- cuptnew = snpmarkers[newsnpnum] ;
-
- for (;;) {
- if (numld==0) break ;
- cuptold = snpmarkers[ldsnpbuff[0]] ;
- pdiff = nnint(cuptnew -> physpos - cuptold -> physpos) ;
- gdiff = cuptnew -> genpos - cuptold -> genpos ;
- if ((pdiff <= ldposlimit) && (gdiff<=ldlimit)) break ;
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
+ numld = *pnumld;
- if (numld < maxld) {
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
- *pnumld = numld ;
- return ;
- }
-
- if (maxld == numld) {
- copyarr(gsource+n, gsource, (maxld-1)*n) ; // overlapping move but copyarr works left to right
- copyiarr(ldsnpbuff+1, ldsnpbuff, (maxld-1)) ; // overlapping move but copyiarr works left to right
- --numld ;
- }
- copyarr(newsource, gsource + numld*n, n) ;
- ldsnpbuff[numld] = newsnpnum ;
- ++numld ;
+ cuptnew = snpmarkers[newsnpnum];
+
+ for (;;)
+ {
+ if (numld == 0)
+ break;
+ cuptold = snpmarkers[ldsnpbuff[0]];
+ pdiff = nnint (cuptnew->physpos - cuptold->physpos);
+ gdiff = cuptnew->genpos - cuptold->genpos;
+ if ((pdiff <= ldposlimit) && (gdiff <= ldlimit))
+ break;
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+
+ if (numld < maxld)
+ {
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
+ *pnumld = numld;
+ return;
+ }
+
+ if (maxld == numld)
+ {
+ copyarr (gsource + n, gsource, (maxld - 1) * n); // overlapping move but copyarr works left to right
+ copyiarr (ldsnpbuff + 1, ldsnpbuff, (maxld - 1)); // overlapping move but copyiarr works left to right
+ --numld;
+ }
+ copyarr (newsource, gsource + numld * n, n);
+ ldsnpbuff[numld] = newsnpnum;
+ ++numld;
- *pnumld = numld ;
- return ;
+ *pnumld = numld;
+ return;
}
-int ldregx(double *gsource, double *gtarget, double *res, int rsize,
- int n, double r2lo, double r2hi)
+int
+ldregx (double *gsource, double *gtarget, double *res, int rsize, int n,
+ double r2lo, double r2hi)
{
-/**
- gsource: array of (normalized) genotypes
- rsize rows n long.
- So row 1 is gsource[0]..gsource[n-1]
- row 2 gsource[n]...gsource[2*n-1]
- gtarget n long normalized genotype
- Routine should return residual (n long)
-
- return code
- a) 0 Did nothing
- b) 1 Ran regression
- c) 2 Residual set 0
-*/
-
- if (rsize==0) {
- copyarr(gtarget, res, n) ;
- return 0 ;
- }
+ /**
+ gsource: array of (normalized) genotypes
+ rsize rows n long.
+ So row 1 is gsource[0]..gsource[n-1]
+ row 2 gsource[n]...gsource[2*n-1]
+ gtarget n long normalized genotype
+ Routine should return residual (n long)
+
+ return code
+ a) 0 Did nothing
+ b) 1 Ran regression
+ c) 2 Residual set 0
+ */
+
+ if (rsize == 0)
+ {
+ copyarr (gtarget, res, n);
+ return 0;
+ }
// Allocate space for all genotypes to pass
- double *gsource_pass ;
- ZALLOC(gsource_pass , rsize * n , double);
+ double *gsource_pass;
+ ZALLOC(gsource_pass, rsize * n, double);
- int i,ii;
+ int i, ii;
// Compute correlation to previous SNPs
double sum;
- int rsize_pass = 0 ;
- for ( i = 0 ; i < rsize ; i++ ) {
- sum = 0;
- for ( ii = 0 ; ii < n ; ii++ ) {
- sum += gtarget[ii] * gsource[i*n+ii] ;
- }
- // Normalize by (n-1) and square to get cor^2
- sum = pow(sum / (2*(n-1)),2) ;
- // Check if correlation too high
- if ( sum > r2hi ) {
- // Clean up and exit
- free(gsource_pass);
-
- // Residual set to all zero
- for ( ii = 0 ; ii < n ; ii++ ) res[ii] = 0;
- return 2;
- // Check if correlation not too low
- } else if ( sum > r2lo ) {
- // Retain this SNP for the regression
- for ( ii = 0 ; ii < n ; ii++ ) gsource_pass[rsize_pass*n+ii] = gsource[i*n+ii] ;
- rsize_pass++;
+ int rsize_pass = 0;
+ for (i = 0; i < rsize; i++)
+ {
+ sum = 0;
+ for (ii = 0; ii < n; ii++)
+ {
+ sum += gtarget[ii] * gsource[i * n + ii];
+ }
+ // Normalize by (n-1) and square to get cor^2
+ sum = pow (sum / (2 * (n - 1)), 2);
+ // Check if correlation too high
+ if (sum > r2hi)
+ {
+ // Clean up and exit
+ free (gsource_pass);
+
+ // Residual set to all zero
+ for (ii = 0; ii < n; ii++)
+ res[ii] = 0;
+ return 2;
+ // Check if correlation not too low
+ }
+ else if (sum > r2lo)
+ {
+ // Retain this SNP for the regression
+ for (ii = 0; ii < n; ii++)
+ gsource_pass[rsize_pass * n + ii] = gsource[i * n + ii];
+ rsize_pass++;
+ }
}
- }
// Do the regression if correlated SNPs were found
- if ( rsize_pass > 0 ) {
- double *t_gsource_pass , *regans , *www;
- ZALLOC(regans, rsize, double) ;
- ZALLOC(www, n, double) ;
- ZALLOC(t_gsource_pass , rsize * n , double);
-
- // Transpose gsource_pass to comply with regressit
- transpose(t_gsource_pass,gsource_pass,rsize,n);
-
- regressit(regans, t_gsource_pass, gtarget, n, rsize_pass) ;
- mulmat(www, regans, gsource_pass, 1, rsize_pass, n) ;
- vvm(res, gtarget, www, n) ;
-
- free(regans) ;
- free(www) ;
- free(t_gsource_pass) ;
- free(gsource_pass);
- return 1;
- }
- else {
- copyarr(gtarget, res, n) ;
- free(gsource_pass);
- return 0;
- }
-}
+ if (rsize_pass > 0)
+ {
+ double *t_gsource_pass, *regans, *www;
+ ZALLOC(regans, rsize, double);
+ ZALLOC(www, n, double);
+ ZALLOC(t_gsource_pass, rsize * n, double);
+ // Transpose gsource_pass to comply with regressit
+ transpose (t_gsource_pass, gsource_pass, rsize, n);
-void dofstxx(double *fstans, double *fstsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+ regressit (regans, t_gsource_pass, gtarget, n, rsize_pass);
+ mulmat (www, regans, gsource_pass, 1, rsize_pass, n);
+ vvm (res, gtarget, www, n);
-{
+ free (regans);
+ free (www);
+ free (t_gsource_pass);
+ free (gsource_pass);
+ return 1;
+ }
+ else
+ {
+ copyarr (gtarget, res, n);
+ free (gsource_pass);
+ return 0;
+ }
+}
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xfst ;
+void
+dofstxx (double *fstans, double *fstsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
- if ( qtmode == YES ) {
- return;
- }
+{
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
- printf("number of blocks for moving block jackknife: %d\n", nblocks) ;
- if ( nblocks <= 1 ) {
- return;
- }
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xfst;
+
+ if (qtmode == YES)
+ {
+ return;
+ }
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xfst, numeg*numeg, double) ;
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
+ printf ("number of blocks for moving block jackknife: %d\n", nblocks);
+ if (nblocks <= 1)
+ {
+ return;
+ }
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xfst, numeg*numeg, double);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- dofstnumx(xfst, fstans, fstsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm, YES) ;
+ dofstnumx (xfst, fstans, fstsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm, YES);
- free(blstart) ;
- free(blsize) ;
- free(xfst) ;
+ free (blstart);
+ free (blsize);
+ free (xfst);
}
-void fixwt(SNP **snpm, int nsnp, double val)
+void
+fixwt (SNP **snpm, int nsnp, double val)
{
- int k ;
- SNP *cupt ;
+ int k;
+ SNP *cupt;
- for (k=0; k<nsnp; ++k) {
- cupt = snpm[k] ;
- cupt -> weight = val ;
- }
+ for (k = 0; k < nsnp; ++k)
+ {
+ cupt = snpm[k];
+ cupt->weight = val;
+ }
}
-double oldfstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+oldfstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- static int ncall = 0;
-
-
- ++ncall ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = rawcol[i] ;
- if (g<0) continue ;
- cc[0] += g ;
- cc[1] += 2-g ;
- }
- if (ncall < 0) {
- printf("qq2\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ static int ncall = 0;
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<0.1) || (zz<0.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- return 0.0;
- }
+ ++ncall;
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = rawcol[i];
+ if (g < 0)
+ continue;
+ cc[0] += g;
+ cc[1] += 2 - g;
+ }
+ if (ncall < 0)
+ {
+ printf ("qq2\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 0.1) || (zz < 0.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ return 0.0;
+ }
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- *estn = en ;
- *estd = ed ;
-
+ ed = en;
+ ed += h1;
+ ed += h2;
- free(rawcol) ;
- return z + zz ;
+ *estn = en;
+ *estd = ed;
-}
+ free (rawcol);
+ return z + zz;
+}
-double fstcol(double *estn, double *estd, SNP *cupt,
- int *xindex, int *xtypes, int nrows, int type1, int type2)
+double
+fstcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
+ int nrows, int type1, int type2)
{
- int c1[2], c2[2], *cc ;
- int *rawcol ;
- int k, g, i ;
- double ya, yb, yaa, ybb, p1, p2, en, ed ;
- double z, zz, h1, h2, yt ;
- int **ccc ;
- static int ncall = 0 ;
-
-
- ++ncall ;
- ccc = initarray_2Dint(nrows, 2, 0) ;
- ZALLOC(rawcol, nrows, int) ;
-
- getrawcolx(ccc, cupt, xindex, nrows, indivmarkers) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
-
- ivzero(c1, 2) ;
- ivzero(c2, 2) ;
-
- for (i=0; i< nrows; i++) {
- k = xtypes[i] ;
- cc = NULL ;
- if (k==type1) cc = c1 ;
- if (k==type2) cc = c2 ;
- if (cc == NULL) continue ;
- g = ccc[i][0] ;
- if (ncall < 1000) {
+ int c1[2], c2[2], *cc;
+ int *rawcol;
+ int k, g, i;
+ double ya, yb, yaa, ybb, p1, p2, en, ed;
+ double z, zz, h1, h2, yt;
+ int **ccc;
+ static int ncall = 0;
+
+ ++ncall;
+ ccc = initarray_2Dint (nrows, 2, 0);
+ ZALLOC(rawcol, nrows, int);
+
+ getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
+ getrawcol (rawcol, cupt, xindex, nrows);
+
+ ivzero (c1, 2);
+ ivzero (c2, 2);
+
+ for (i = 0; i < nrows; i++)
+ {
+ k = xtypes[i];
+ cc = NULL;
+ if (k == type1)
+ cc = c1;
+ if (k == type2)
+ cc = c2;
+ if (cc == NULL)
+ continue;
+ g = ccc[i][0];
+ if (ncall < 1000)
+ {
// printf("zz %d %d %d\n", rawcol[i], ccc[i][0], ccc[i][1]) ;
+ }
+
+ if (g < 0)
+ continue;
+ ivvp (cc, cc, ccc[i], 2);
}
-
- if (g<0) continue ;
- ivvp(cc, cc, ccc[i], 2) ;
- }
- if (ncall < 0) {
- printf("qqq\n") ;
- printimat(c1, 1, 2) ;
- printimat(c2, 1, 2) ;
- }
+ if (ncall < 0)
+ {
+ printf ("qqq\n");
+ printimat (c1, 1, 2);
+ printimat (c2, 1, 2);
+ }
+
+ ya = c1[0];
+ yb = c1[1];
+ yaa = c2[0];
+ ybb = c2[1];
+ z = ya + yb;
+ zz = yaa + ybb;
+ if ((z < 1.1) || (zz < 1.1))
+ {
+ *estn = 0.0;
+ *estd = -1.0;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return 0.0;
+ }
- ya = c1[0] ;
- yb = c1[1] ;
- yaa = c2[0] ;
- ybb = c2[1] ;
- z = ya + yb ;
- zz = yaa+ybb ;
- if ((z<1.1) || (zz<1.1)) {
- *estn = 0.0 ;
- *estd = -1.0 ;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return 0.0;
- }
+ yt = ya + yb;
+ p1 = ya / yt;
+ h1 = ya * yb / (yt * (yt - 1.0));
- yt = ya+yb ;
- p1 = ya/yt ;
- h1 = ya*yb/(yt*(yt-1.0)) ;
+ yt = yaa + ybb;
+ p2 = yaa / yt;
+ h2 = yaa * ybb / (yt * (yt - 1.0));
- yt = yaa+ybb ;
- p2 = yaa/yt ;
- h2 = yaa*ybb/(yt*(yt-1.0)) ;
+ en = (p1 - p2) * (p1 - p2);
+ en -= h1 / z;
+ en -= h2 / zz;
- en = (p1-p2)*(p1-p2) ;
- en -= h1/z ;
- en -= h2/zz ;
-
- ed = en ;
- ed += h1 ;
- ed += h2 ;
+ ed = en;
+ ed += h1;
+ ed += h2;
- *estn = en ;
- *estd = ed ;
-
+ *estn = en;
+ *estd = ed;
- free(rawcol) ;
- free2Dint(&ccc, nrows) ;
- return z + zz ;
+ free (rawcol);
+ free2Dint (&ccc, nrows);
+ return z + zz;
}
void
-writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
+writesnpeigs (char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs,
+ int ncols)
{
// this is called at end and ffvecs overwritten
- double *xpt, y, yscal, *snpsc ;
- int i, j, k, kmax, kmin ;
- SNP * cupt ;
- FILE *fff ;
-
- for (j=0; j<numeigs; ++j) {
- xpt = ffvecs+j*ncols ;
- y = asum2(xpt, ncols) ;
- yscal = (double) ncols / y ;
- yscal = sqrt(yscal) ;
- vst(xpt, xpt, yscal, ncols) ;
- }
+ double *xpt, y, yscal, *snpsc;
+ int i, j, k, kmax, kmin;
+ SNP * cupt;
+ FILE *fff;
+ for (j = 0; j < numeigs; ++j)
+ {
+ xpt = ffvecs + j * ncols;
+ y = asum2 (xpt, ncols);
+ yscal = (double) ncols / y;
+ yscal = sqrt (yscal);
+ vst (xpt, xpt, yscal, ncols);
+ }
- ZALLOC(snpsc, ncols, double) ;
- vclear(snpsc, -99999, ncols) ;
- for (j=0; j<numeigs; ++j) {
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
- y = ffvecs[j*ncols+i] ;
- snpsc[i] = fabs(y) ;
- }
- for (k=0; k<10; ++k) {
+ ZALLOC(snpsc, ncols, double);
+ vclear (snpsc, -99999, ncols);
+ for (j = 0; j < numeigs; ++j)
+ {
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
+ y = ffvecs[j * ncols + i];
+ snpsc[i] = fabs (y);
+ }
+ for (k = 0; k < 10; ++k)
+ {
// was <= 10 Tiny bug
- vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
- cupt = xsnplist[kmax] ;
- if (snpsc[kmax]<0) break ;
- printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
- snpsc[kmax] = -1.0 ;
- }
- }
- free(snpsc) ;
-
+ vlmaxmin (snpsc, ncols, &kmax, &kmin);
+ cupt = xsnplist[kmax];
+ if (snpsc[kmax] < 0)
+ break;
+ printf ("eigbestsnp %4d %20s %2d %12d %9.3f\n", j + 1, cupt->ID,
+ cupt->chrom, nnint (cupt->physpos), snpsc[kmax]);
+ snpsc[kmax] = -1.0;
+ }
+ }
+ free (snpsc);
- if (snpeigname == NULL) return ;
- openit (snpeigname, &fff, "w") ;
+ if (snpeigname == NULL)
+ return;
+ openit (snpeigname, &fff, "w");
- for (i=0; i<ncols; ++i) {
- cupt = xsnplist[i] ;
- if (cupt -> ignore) continue ;
+ for (i = 0; i < ncols; ++i)
+ {
+ cupt = xsnplist[i];
+ if (cupt->ignore)
+ continue;
- fprintf(fff, "%20s", cupt -> ID) ;
- fprintf(fff, " %2d", cupt -> chrom) ;
- fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
+ fprintf (fff, "%20s", cupt->ID);
+ fprintf (fff, " %2d", cupt->chrom);
+ fprintf (fff, " %12d", nnint (cupt->physpos));
- for (j=0; j<numeigs; ++j) {
- fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
- }
- fprintf(fff, "\n") ;
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ fprintf (fff, " %9.3f", ffvecs[j * ncols + i]);
+ }
+ fprintf (fff, "\n");
+ }
- fclose(fff) ;
+ fclose (fff);
}
@@ -2406,96 +2780,110 @@ writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int
* g[i] set to zero where missing data
* */
-
int
-getcolxz(double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
- double *xmean, double *xfancy, int *n0, int *n1)
+getcolxz (double *xcol, SNP *cupt, int *xindex, int *xtypes, int nrows, int col,
+ double *xmean, double *xfancy, int *n0, int *n1)
// side effect set xmean xfancy and count variant and reference alleles
// returns missings after fill in
{
- int j, n, g, t, k, kmax = -1 ;
- double y, pmean, yfancy ;
- int *rawcol ;
- int c0, c1, nmiss ;
- double* popnum = NULL;
- double* popsum = NULL;
-
- if (usepopsformissing) {
- ZALLOC(popnum, MAXPOPS+1, double) ;
- ZALLOC(popsum, MAXPOPS+1, double) ;
- }
+ int j, n, g, t, k, kmax = -1;
+ double y, pmean, yfancy;
+ int *rawcol;
+ int c0, c1, nmiss;
+ double* popnum = NULL;
+ double* popsum = NULL;
- c0 = c1 = 0 ;
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g<0) {
- ++nmiss ;
- continue ;
- }
- c0 += g ;
- c1 += 2-g ;
- if (usepopsformissing) {
- k = xtypes[j] ;
- popsum[k] += (double) g ;
- popnum[k] += 1.0 ;
- kmax = MAX(kmax, k) ;
- }
- }
- floatit(xcol, rawcol, nrows) ;
- if ((usepopsformissing) && (nmiss > 0)) {
- pmean = asum(popsum, kmax+1)/asum(popnum, kmax+1) ;
- nmiss = 0 ;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j] ;
- if (g>=0) continue ;
- k = xtypes[j] ;
- if (popnum[k] > 0.5) {
- y = popsum[k]/popnum[k] ;
- xcol[j] = y ;
- continue ;
- }
- ++nmiss ;
- }
- }
- t = fvadjust(xcol, nrows, &pmean, &yfancy) ;
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0 ;
- xfancy[col] = 0.0 ;
- }
- vzero(xcol, nrows) ;
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = -1 ;
- *n1 = -1 ;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- if (usepopsformissing) {
- free(popnum) ;
- free(popsum) ;
- }
- return nmiss ;
+ if (usepopsformissing)
+ {
+ ZALLOC(popnum, MAXPOPS+1, double);
+ ZALLOC(popsum, MAXPOPS+1, double);
+ }
+
+ c0 = c1 = 0;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ if (usepopsformissing)
+ {
+ k = xtypes[j];
+ popsum[k] += (double) g;
+ popnum[k] += 1.0;
+ kmax = MAX(kmax, k);
+ }
+ }
+ floatit (xcol, rawcol, nrows);
+ if ((usepopsformissing) && (nmiss > 0))
+ {
+ pmean = asum (popsum, kmax + 1) / asum (popnum, kmax + 1);
+ nmiss = 0;
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g >= 0)
+ continue;
+ k = xtypes[j];
+ if (popnum[k] > 0.5)
+ {
+ y = popsum[k] / popnum[k];
+ xcol[j] = y;
+ continue;
+ }
+ ++nmiss;
+ }
+ }
+ t = fvadjust (xcol, nrows, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, nrows);
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ if (usepopsformissing)
+ {
+ free (popnum);
+ free (popsum);
+ }
+ return nmiss;
}
int
-getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
- int col, double* xmean, double* xfancy, int* n0, int* n1)
+getcolxz_binary1 (int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
+ int col, double* xmean, double* xfancy, int* n0, int* n1)
{
// Modified getcolxz() which converts to a 3-bit-per-genotype representation
// compatible with PLINK 1.5's partial sum lookup outer product algorithm.
@@ -2537,49 +2925,57 @@ getcolxz_binary1(int* rawcol, double* xcol, SNP* cupt, int* xindex, int nrows,
c0 = c1 = 0;
n = cupt->ngtypes;
- if (n < nrows) {
- fatalx("bad snp: %s %d\n", cupt->ID, n);
- }
- getrawcol(rawcol, cupt, xindex, nrows);
+ if (n < nrows)
+ {
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ }
+ getrawcol (rawcol, cupt, xindex, nrows);
nmiss = 0;
- for (j=0; j<nrows; ++j) {
- g = rawcol[j];
- if (g<0) {
- ++nmiss;
- continue;
- }
- c0 += g;
- c1 += 2-g;
- }
+ for (j = 0; j < nrows; ++j)
+ {
+ g = rawcol[j];
+ if (g < 0)
+ {
+ ++nmiss;
+ continue;
+ }
+ c0 += g;
+ c1 += 2 - g;
+ }
// instead of storing an entire column of floating point values,
- t = fvadjust_binary(c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
- if (t < -99) {
- if (xmean != NULL) {
- xmean[col] = 0.0;
- xfancy[col] = 0.0;
- }
- vzero(xcol, 3);
- if (n0 != NULL) {
- *n0 = -1;
- *n1 = -1;
- }
- return -1;
- }
- vst(xcol, xcol, yfancy, 3);
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy;
- xfancy[col] = yfancy;
- }
- if (n0 != NULL) {
- *n0 = c0 ;
- *n1 = c1 ;
- }
- return nmiss ;
+ t = fvadjust_binary (c0, c1, nmiss, nrows, xcol, &pmean, &yfancy);
+ if (t < -99)
+ {
+ if (xmean != NULL)
+ {
+ xmean[col] = 0.0;
+ xfancy[col] = 0.0;
+ }
+ vzero (xcol, 3);
+ if (n0 != NULL)
+ {
+ *n0 = -1;
+ *n1 = -1;
+ }
+ return -1;
+ }
+ vst (xcol, xcol, yfancy, 3);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ if (n0 != NULL)
+ {
+ *n0 = c0;
+ *n1 = c1;
+ }
+ return nmiss;
}
void
-getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
- uint32_t xblock, uint32_t nrows)
+getcolxz_binary2 (int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t xblock, uint32_t nrows)
{
// slightly better to position at 0-3-6-9-12-16-19... instead of
// 0-3-6-9-12-15-18...
@@ -2588,34 +2984,41 @@ getcolxz_binary2(int* rawcol, uintptr_t* binary_cols, uintptr_t* binary_mmask,
uintptr_t bitfield_or[3];
uint32_t row_idx;
int cur_geno;
- bitfield_or[0] = ((uintptr_t)7) << shift_val;
- bitfield_or[1] = ((uintptr_t)2) << shift_val;
- bitfield_or[2] = ((uintptr_t)3) << shift_val;
- for (row_idx = 0; row_idx < nrows; row_idx++) {
- cur_geno = *rawcol++;
- if (cur_geno) {
- if (cur_geno > 0) {
- binary_cols[row_idx] |= bitfield_or[(uint32_t)cur_geno];
- } else {
- binary_mmask[row_idx] |= bitfield_or[0];
- }
+ bitfield_or[0] = ((uintptr_t) 7) << shift_val;
+ bitfield_or[1] = ((uintptr_t) 2) << shift_val;
+ bitfield_or[2] = ((uintptr_t) 3) << shift_val;
+ for (row_idx = 0; row_idx < nrows; row_idx++)
+ {
+ cur_geno = *rawcol++;
+ if (cur_geno)
+ {
+ if (cur_geno > 0)
+ {
+ binary_cols[row_idx] |= bitfield_or[(uint32_t) cur_geno];
+ }
+ else
+ {
+ binary_mmask[row_idx] |= bitfield_or[0];
+ }
+ }
}
- }
}
void
-join_threads(pthread_t* threads, uint32_t ctp1)
+join_threads (pthread_t* threads, uint32_t ctp1)
{
- if (!(--ctp1)) {
- return;
- }
+ if (!(--ctp1))
+ {
+ return;
+ }
#if _WIN32
WaitForMultipleObjects(ctp1, threads, 1, INFINITE);
#else
uint32_t uii;
- for (uii = 0; uii < ctp1; uii++) {
- pthread_join(threads[uii], NULL);
- }
+ for (uii = 0; uii < ctp1; uii++)
+ {
+ pthread_join (threads[uii], NULL);
+ }
#endif
}
@@ -2624,82 +3027,100 @@ int32_t
spawn_threads(pthread_t* threads, unsigned (__stdcall *start_routine)(void*), uintptr_t ct)
#else
int32_t
-spawn_threads(pthread_t* threads, void* (*start_routine)(void*), uintptr_t ct)
+spawn_threads (pthread_t* threads, void*
+(*start_routine) (void*),
+ uintptr_t ct)
#endif
{
uintptr_t ulii;
- if (ct == 1) {
- return 0;
- }
- for (ulii = 1; ulii < ct; ulii++) {
-#if _WIN32
- threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
- if (!threads[ulii - 1]) {
- join_threads(threads, ulii);
- return -1;
+ if (ct == 1)
+ {
+ return 0;
}
+ for (ulii = 1; ulii < ct; ulii++)
+ {
+#if _WIN32
+ threads[ulii - 1] = (HANDLE)_beginthreadex(NULL, 4096, start_routine, (void*)ulii, 0, NULL);
+ if (!threads[ulii - 1])
+ {
+ join_threads(threads, ulii);
+ return -1;
+ }
#else
- if (pthread_create(&(threads[ulii - 1]), NULL, start_routine, (void*)ulii)) {
- join_threads(threads, ulii);
- return -1;
- }
+ if (pthread_create (&(threads[ulii - 1]), NULL, start_routine,
+ (void*) ulii))
+ {
+ join_threads (threads, ulii);
+ return -1;
+ }
#endif
- }
+ }
return 0;
}
-THREAD_RET_TYPE block_increment_binary(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t cur_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t* binary_cols = g_binary_cols;
- uintptr_t* binary_mmask = g_binary_mmask;
- double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
- double* weights0 = g_weights;
- double* weights1 = &(g_weights[32768]);
+THREAD_RET_TYPE block_increment_binary(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t cur_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t* binary_cols = g_binary_cols;
+ uintptr_t* binary_mmask = g_binary_mmask;
+ double* write_ptr = &(g_XTX_lower_tri[(cur_indiv_idx * (cur_indiv_idx + 1)) / 2]);
+ double* weights0 = g_weights;
+ double* weights1 = &(g_weights[32768]);
#ifdef __LP64__
- double* weights2 = &(g_weights[65536]);
- double* weights3 = &(g_weights[98304]);
+ double* weights2 = &(g_weights[65536]);
+ double* weights3 = &(g_weights[98304]);
#endif
- uintptr_t* geno_ptr;
- uintptr_t* mmask_ptr;
- uintptr_t base_geno;
- uintptr_t base_mmask;
- uintptr_t final_geno;
- uintptr_t indiv_idx2;
- for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- geno_ptr = binary_cols;
- base_geno = binary_cols[cur_indiv_idx];
- mmask_ptr = binary_mmask;
- base_mmask = binary_mmask[cur_indiv_idx];
- if (!base_mmask) {
- // special case: current individual has no missing genotypes in block
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
+ uintptr_t* geno_ptr;
+ uintptr_t* mmask_ptr;
+ uintptr_t base_geno;
+ uintptr_t base_mmask;
+ uintptr_t final_geno;
+ uintptr_t indiv_idx2;
+ for (; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ geno_ptr = binary_cols;
+ base_geno = binary_cols[cur_indiv_idx];
+ mmask_ptr = binary_mmask;
+ base_mmask = binary_mmask[cur_indiv_idx];
+ if (!base_mmask)
+ {
+ // special case: current individual has no missing genotypes in block
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | (*mmask_ptr++);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
- }
- } else {
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
+ write_ptr++;
+ }
+ }
+ else
+ {
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ final_geno = ((*geno_ptr++) + base_geno) | ((*mmask_ptr++) | base_mmask);
#ifdef __LP64__
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[(uint16_t)(final_geno >> 16)] + weights2[(uint16_t)(final_geno >> 32)] + weights3[final_geno >> 48];
#else
- *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
+ *write_ptr += weights0[(uint16_t)final_geno] + weights1[final_geno >> 16];
#endif
- write_ptr++;
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lower_tri, double* tblock, uintptr_t* binary_cols, uintptr_t* binary_mmask, uint32_t block_size, uint32_t indiv_ct, double* partial_sum_lookup_buf)
+domult_increment_lookup (pthread_t* threads, uint32_t thread_ct,
+ double *XTX_lower_tri, double* tblock,
+ uintptr_t* binary_cols, uintptr_t* binary_mmask,
+ uint32_t block_size, uint32_t indiv_ct,
+ double* partial_sum_lookup_buf)
{
// PLINK 1.5 partial sum lookup algorithm
double increments[40];
@@ -2723,80 +3144,93 @@ domult_increment_lookup(pthread_t* threads, uint32_t thread_ct, double *XTX_lowe
#else
for (uii = 0; uii < 10; uii += 5)
#endif
- {
- dptr = increments;
- for (ujj = 0; ujj < 5; ujj++) {
- dptr2 = &(tblock[(uii + ujj) * 3]);
- *dptr++ = dptr2[0] * dptr2[0];
- *dptr++ = 0;
- *dptr++ = dptr2[0] * dptr2[1];
- *dptr++ = dptr2[0] * dptr2[2];
- *dptr++ = dptr2[1] * dptr2[1];
- *dptr++ = dptr2[1] * dptr2[2];
- *dptr++ = dptr2[2] * dptr2[2];
- *dptr++ = 0;
- }
- dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
- for (ujj = 0; ujj < 8; ujj++) {
- partial_incr1 = increments[ujj + 32];
- for (ukk = 0; ukk < 8; ukk++) {
- partial_incr2 = partial_incr1 + increments[ukk + 24];
- for (umm = 0; umm < 8; umm++) {
- partial_incr3 = partial_incr2 + increments[umm + 16];
- for (unn = 0; unn < 8; unn++) {
- partial_incr4 = partial_incr3 + increments[unn + 8];
- for (uoo = 0; uoo < 8; uoo++) {
- *dptr++ = partial_incr4 + increments[uoo];
- }
- }
- }
- }
+ {
+ dptr = increments;
+ for (ujj = 0; ujj < 5; ujj++)
+ {
+ dptr2 = &(tblock[(uii + ujj) * 3]);
+ *dptr++ = dptr2[0] * dptr2[0];
+ *dptr++ = 0;
+ *dptr++ = dptr2[0] * dptr2[1];
+ *dptr++ = dptr2[0] * dptr2[2];
+ *dptr++ = dptr2[1] * dptr2[1];
+ *dptr++ = dptr2[1] * dptr2[2];
+ *dptr++ = dptr2[2] * dptr2[2];
+ *dptr++ = 0;
+ }
+ dptr = &(partial_sum_lookup_buf[(uii / 5) * 32768]);
+ for (ujj = 0; ujj < 8; ujj++)
+ {
+ partial_incr1 = increments[ujj + 32];
+ for (ukk = 0; ukk < 8; ukk++)
+ {
+ partial_incr2 = partial_incr1 + increments[ukk + 24];
+ for (umm = 0; umm < 8; umm++)
+ {
+ partial_incr3 = partial_incr2 + increments[umm + 16];
+ for (unn = 0; unn < 8; unn++)
+ {
+ partial_incr4 = partial_incr3 + increments[unn + 8];
+ for (uoo = 0; uoo < 8; uoo++)
+ {
+ *dptr++ = partial_incr4 + increments[uoo];
+ }
+ }
+ }
+ }
+ }
}
- }
g_XTX_lower_tri = XTX_lower_tri;
g_weights = partial_sum_lookup_buf;
g_binary_cols = binary_cols;
g_binary_mmask = binary_mmask;
- if (spawn_threads(threads, block_increment_binary, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_binary, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_binary((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_binary ((void*) ulii);
+ join_threads (threads, thread_ct);
}
-THREAD_RET_TYPE block_increment_normal(void* arg) {
- uintptr_t tidx = (uintptr_t)arg;
- uintptr_t start_indiv_idx = g_thread_start[tidx];
- uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
- uintptr_t indiv_ct = g_indiv_ct;
- uint32_t block_size = g_block_size;
- double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
- double* write_ptr;
- double* tblock;
- double* tblock_read_ptr;
- double cur_tblock_val;
- uintptr_t cur_indiv_idx;
- uintptr_t indiv_idx2;
- uint32_t bidx;
- for (bidx = 0; bidx < block_size; bidx++) {
- write_ptr = write_start_ptr;
- tblock = &(g_tblock[bidx * indiv_ct]);
- for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++) {
- cur_tblock_val = tblock[cur_indiv_idx];
- tblock_read_ptr = tblock;
- for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++) {
- *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
- write_ptr++;
+THREAD_RET_TYPE block_increment_normal(void* arg)
+ {
+ uintptr_t tidx = (uintptr_t)arg;
+ uintptr_t start_indiv_idx = g_thread_start[tidx];
+ uintptr_t end_indiv_idx = g_thread_start[tidx + 1];
+ uintptr_t indiv_ct = g_indiv_ct;
+ uint32_t block_size = g_block_size;
+ double* write_start_ptr = &(g_XTX_lower_tri[(start_indiv_idx * (start_indiv_idx + 1)) / 2]);
+ double* write_ptr;
+ double* tblock;
+ double* tblock_read_ptr;
+ double cur_tblock_val;
+ uintptr_t cur_indiv_idx;
+ uintptr_t indiv_idx2;
+ uint32_t bidx;
+ for (bidx = 0; bidx < block_size; bidx++)
+ {
+ write_ptr = write_start_ptr;
+ tblock = &(g_tblock[bidx * indiv_ct]);
+ for (cur_indiv_idx = start_indiv_idx; cur_indiv_idx < end_indiv_idx; cur_indiv_idx++)
+ {
+ cur_tblock_val = tblock[cur_indiv_idx];
+ tblock_read_ptr = tblock;
+ for (indiv_idx2 = 0; indiv_idx2 <= cur_indiv_idx; indiv_idx2++)
+ {
+ *write_ptr += cur_tblock_val * (*tblock_read_ptr++);
+ write_ptr++;
+ }
+ }
}
- }
+ THREAD_RETURN;
}
- THREAD_RETURN;
-}
void
-domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lower_tri, double* tblock, int block_size, uint32_t indiv_ct)
+domult_increment_normal (pthread_t* threads, uint32_t thread_ct,
+ double* XTX_lower_tri, double* tblock, int block_size,
+ uint32_t indiv_ct)
{
// General case: tblock[] can have an arbitrary number of distinct values, so
// can't use bit hacks.
@@ -2808,311 +3242,338 @@ domult_increment_normal(pthread_t* threads, uint32_t thread_ct, double* XTX_lowe
int ii;
double ycheck;
uintptr_t ulii;
- for (ii=0; ii<block_size; ii++) {
- ycheck = asum(tblock+ii*indiv_ct, indiv_ct) ;
- if (fabs(ycheck)>.00001) fatalx("bad ycheck\n");
- }
+ for (ii = 0; ii < block_size; ii++)
+ {
+ ycheck = asum (tblock + ii * indiv_ct, indiv_ct);
+ if (fabs (ycheck) > .00001)
+ fatalx ("bad ycheck\n");
+ }
g_XTX_lower_tri = XTX_lower_tri;
g_tblock = tblock;
g_block_size = block_size;
g_indiv_ct = indiv_ct;
- if (spawn_threads(threads, block_increment_normal, thread_ct)) {
- fatalx("Error: Failed to create thread.\n");
- return;
- }
+ if (spawn_threads (threads, block_increment_normal, thread_ct))
+ {
+ fatalx ("Error: Failed to create thread.\n");
+ return;
+ }
ulii = 0;
- block_increment_normal((void*)ulii);
- join_threads(threads, thread_ct);
+ block_increment_normal ((void*) ulii);
+ join_threads (threads, thread_ct);
}
void
-getcolxf(double *xcol, SNP *cupt, int *xindex, int nrows, int col,
- double *xmean, double *xfancy)
+getcolxf (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
+ double *xmean, double *xfancy)
// side effect set xmean xfancy
{
- int n ;
- double pmean, yfancy ;
- int *rawcol ;
+ int n;
+ double pmean, yfancy;
+ int *rawcol;
- if (xmean != NULL) {
- xmean[col] = xfancy[col] = 0.0 ;
- }
+ if (xmean != NULL)
+ {
+ xmean[col] = xfancy[col] = 0.0;
+ }
- if (cupt -> ignore) {
- vzero(xcol, nrows) ;
- return ;
- }
+ if (cupt->ignore)
+ {
+ vzero (xcol, nrows);
+ return;
+ }
- ZALLOC(rawcol, nrows, int) ;
- n = cupt -> ngtypes ;
- if (n<nrows) fatalx("bad snp: %s %d\n", cupt -> ID, n) ;
- getrawcol(rawcol, cupt, xindex, nrows) ;
- floatit(xcol, rawcol, nrows) ;
-
- fvadjust(xcol, nrows, &pmean, &yfancy) ;
- vst(xcol, xcol, yfancy, nrows) ;
- if (xmean != NULL) {
- xmean[col] = pmean*yfancy ;
- xfancy[col] = yfancy ;
- }
- free(rawcol) ;
+ ZALLOC(rawcol, nrows, int);
+ n = cupt->ngtypes;
+ if (n < nrows)
+ fatalx ("bad snp: %s %d\n", cupt->ID, n);
+ getrawcol (rawcol, cupt, xindex, nrows);
+ floatit (xcol, rawcol, nrows);
+
+ fvadjust (xcol, nrows, &pmean, &yfancy);
+ vst (xcol, xcol, yfancy, nrows);
+ if (xmean != NULL)
+ {
+ xmean[col] = pmean * yfancy;
+ xfancy[col] = yfancy;
+ }
+ free (rawcol);
}
-void doinbxx(double *inbans, double *inbsd, SNP **xsnplist, int *xindex, int *xtypes,
- int nrows, int ncols, int numeg, double blgsize, SNP **snpmarkers, Indiv **indm)
+void
+doinbxx (double *inbans, double *inbsd, SNP **xsnplist, int *xindex,
+ int *xtypes, int nrows, int ncols, int numeg, double blgsize,
+ SNP **snpmarkers, Indiv **indm)
{
- int nblocks, xnblocks ;
- int *blstart, *blsize ;
- double *xinb ;
+ int nblocks, xnblocks;
+ int *blstart, *blsize;
+ double *xinb;
- nblocks = numblocks(snpmarkers, numsnps, blgsize) ;
+ nblocks = numblocks (snpmarkers, numsnps, blgsize);
- ZALLOC(blstart, nblocks, int) ;
- ZALLOC(blsize, nblocks, int) ;
- ZALLOC(xinb, numeg, double) ;
+ ZALLOC(blstart, nblocks, int);
+ ZALLOC(blsize, nblocks, int);
+ ZALLOC(xinb, numeg, double);
+ setblocks (blstart, blsize, &xnblocks, xsnplist, ncols, blgsize);
+ fixwt (xsnplist, ncols, 1.0);
- setblocks(blstart, blsize, &xnblocks, xsnplist, ncols, blgsize) ;
- fixwt(xsnplist, ncols, 1.0) ;
+ doinbreed (xinb, inbans, inbsd, xsnplist, xindex, xtypes, nrows, ncols, numeg,
+ nblocks, indm);
- doinbreed(xinb, inbans, inbsd, xsnplist, xindex, xtypes,
- nrows, ncols, numeg, nblocks, indm) ;
-
- free(blstart) ;
- free(blsize) ;
- free(xinb) ;
+ free (blstart);
+ free (blsize);
+ free (xinb);
}
-
-void calcpopmean(double *wmean, char **elist, double *vec,
- char **eglist, int numeg, int *xtypes, int len)
+void
+calcpopmean (double *wmean, char **elist, double *vec, char **eglist, int numeg,
+ int *xtypes, int len)
// extracted from dotttest ;
{
- double *w0, *w1 ;
- int *isort ;
- int i, k ;
+ double *w0, *w1;
+ int *isort;
+ int i, k;
- ZALLOC(w0, len, double) ;
- ZALLOC(w1, len, double) ;
- ZALLOC(isort, len, int) ;
+ ZALLOC(w0, len, double);
+ ZALLOC(w1, len, double);
+ ZALLOC(isort, len, int);
-
- calcmean(w0, vec, len, xtypes, numeg) ;
+ calcmean (w0, vec, len, xtypes, numeg);
- copyarr(w0, w1, numeg) ;
- sortit(w1, isort, numeg) ;
+ copyarr (w0, w1, numeg);
+ sortit (w1, isort, numeg);
- for (i=0; i<numeg; i++) {
- k = isort[i] ;
- elist[i] = eglist[k] ;
- wmean[i] = w0[k] ;
+ for (i = 0; i < numeg; i++)
+ {
+ k = isort[i];
+ elist[i] = eglist[k];
+ wmean[i] = w0[k];
}
-
-
- free(w0) ;
- free(w1) ;
- free(isort) ;
-
+ free (w0);
+ free (w1);
+ free (isort);
}
void
-sqz(double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
+sqz (double *azq, double *acoeffs, int numeigs, int nrows, int *xindex)
{
- int i, j, k ;
- // Indiv *indx ;
- static int ncall = 0 ;
+ int i, j, k;
+ // Indiv *indx ;
+ static int ncall = 0;
- ++ncall ;
+ ++ncall;
- for (k=0; k<nrows; ++k) {
- i = xindex[k] ;
- if (i<0) fatalx("zzyuk!\n") ;
- // indx = indivmarkers[i] ;
+ for (k = 0; k < nrows; ++k)
+ {
+ i = xindex[k];
+ if (i < 0)
+ fatalx ("zzyuk!\n");
+ // indx = indivmarkers[i] ;
// if (ncall == 1) printf("zz %3d %12s %12s %d %d\n", k, indx -> ID, indx -> egroup, indx -> ignore, indx -> affstatus) ;
- for (j=0; j<numeigs; ++j) {
- azq[j*nrows+k] = acoeffs[j*numindivs+i] ;
- }
- }
+ for (j = 0; j < numeigs; ++j)
+ {
+ azq[j * nrows + k] = acoeffs[j * numindivs + i];
+ }
+ }
}
-void dumpgrmid(char *fname, Indiv **indivmarkers, int *xindex, int numid)
+void
+dumpgrmid (char *fname, Indiv **indivmarkers, int *xindex, int numid)
{
- FILE *fff ;
- int a, b ;
- Indiv *indx ;
-
- openit (fname, &fff, "w") ;
- for (a=0; a<numid; ++a) {
- b = xindex[a] ;
- if ((b<0) || (b>=numindivs)) fatalx("(dumpgrmid) bad index\n") ;
- indx = indivmarkers[b] ;
- fprintf(fff, "%s\t%s\n", "NA", indx -> ID) ;
- }
- fclose(fff) ;
+ FILE *fff;
+ int a, b;
+ Indiv *indx;
+
+ openit (fname, &fff, "w");
+ for (a = 0; a < numid; ++a)
+ {
+ b = xindex[a];
+ if ((b < 0) || (b >= numindivs))
+ fatalx ("(dumpgrmid) bad index\n");
+ indx = indivmarkers[b];
+ fprintf (fff, "%s\t%s\n", "NA", indx->ID);
+ }
+ fclose (fff);
}
void
-dumpgrmbin(double *XTX, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrmbin (double *XTX, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- char sss[256] ;
- char *bb ;
- int wout, numout, fdes, ret = 0 ;
- float yfloat ;
-
- if (sizeof(yfloat) != 4) fatalx("grm binary only supported for 4 byte floats\n") ;
-
- sprintf(sss, "%s.N.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
-
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ double y;
+ char sss[256];
+ char *bb;
+ int wout, numout, fdes, ret = 0;
+ float yfloat;
+
+ if (sizeof(yfloat) != 4)
+ fatalx ("grm binary only supported for 4 byte floats\n");
+
+ sprintf (sss, "%s.N.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// numout = numsnps*(numsnps+1)/4 ;
- numout = nrows*(nrows+1)/2 ;
- wout = numsnps ;
- bb = (char *) &wout ;
-
- for (a=0; a<numout; ++a) {
- ret = write(fdes, bb, 4) ;
- }
- if (ret<0) {
- perror("write failure") ;
- fatalx("(outpack) bad write") ;
- }
- close(fdes) ;
+ numout = nrows * (nrows + 1) / 2;
+ wout = numsnps;
+ bb = (char *) &wout;
- sprintf(sss, "%s.bin", grmoutname) ;
- ridfile(sss) ;
- fdes = open(sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+ for (a = 0; a < numout; ++a)
+ {
+ ret = write (fdes, bb, 4);
+ }
+ if (ret < 0)
+ {
+ perror ("write failure");
+ fatalx ("(outpack) bad write");
+ }
+ close (fdes);
- if (fdes<0) {
- perror("bad dumpgrmbin") ;
- fatalx("open failed for %s\n", sss) ;
- }
+ sprintf (sss, "%s.bin", grmoutname);
+ ridfile (sss);
+ fdes = open (sss, O_CREAT | O_TRUNC | O_RDWR, 0666);
+
+ if (fdes < 0)
+ {
+ perror ("bad dumpgrmbin");
+ fatalx ("open failed for %s\n", sss);
+ }
if (verbose)
- printf("file %s opened\n", sss) ;
+ printf ("file %s opened\n", sss);
// Re-adjust values based on diagonal normalization
- double y_norm ;
- y_norm = trace(XTX, nrows) / (double) nrows ;
-
- bb = (char *) &yfloat ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] / y_norm; // bugfix
- yfloat = (float) y ;
- ret = write(fdes, bb, 4) ;
- }
- }
- close(fdes) ;
+ double y_norm;
+ y_norm = trace (XTX, nrows) / (double) nrows;
+
+ bb = (char *) &yfloat;
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b] / y_norm; // bugfix
+ yfloat = (float) y;
+ ret = write (fdes, bb, 4);
+ }
+ }
+ close (fdes);
}
void
-dumpgrm(double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers, int numindivs, char *grmoutname)
+dumpgrm (double *XTX, int *xindex, int nrows, int numsnps, Indiv **indivmarkers,
+ int numindivs, char *grmoutname)
{
int a, b;
- double y ;
- FILE *fff ;
- char sss[256] ;
-
- if (grmoutname == NULL) return ;
-
- sprintf(sss, "%s.id", grmoutname) ;
- dumpgrmid(sss, indivmarkers, xindex, nrows) ;
-
- if (grmbinary) {
- dumpgrmbin(XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname) ;
- return ;
- }
+ double y;
+ FILE *fff;
+ char sss[256];
+
+ if (grmoutname == NULL)
+ return;
+
+ sprintf (sss, "%s.id", grmoutname);
+ dumpgrmid (sss, indivmarkers, xindex, nrows);
+
+ if (grmbinary)
+ {
+ dumpgrmbin (XTX, nrows, numsnps, indivmarkers, numindivs, grmoutname);
+ return;
+ }
// Re-adjust values based on diagonal normalization
- double y_norm_recip ;
- double *d ;
- ZALLOC(d, nrows, double) ;
- getdiag(d, XTX, nrows) ;
- y_norm_recip = ((double)nrows) / asum(d,nrows);
- free(d) ;
-
- openit(grmoutname, &fff, "w") ;
- for (a = 0; a < nrows; a++ ){
- for (b = 0; b <= a; b++ ){
- y = XTX[a*nrows+b] ; // bugfix: do NOT want to dereference xindex here
- fprintf(fff, "%d %d ", a+1, b+1) ;
- fprintf(fff, "%d ", numsnps) ;
- fprintf(fff, "%0.6f\n", y * y_norm_recip) ;
- }
- }
- fclose(fff) ;
+ double y_norm_recip;
+ double *d;
+ ZALLOC(d, nrows, double);
+ getdiag (d, XTX, nrows);
+ y_norm_recip = ((double) nrows) / asum (d, nrows);
+ free (d);
+
+ openit (grmoutname, &fff, "w");
+ for (a = 0; a < nrows; a++)
+ {
+ for (b = 0; b <= a; b++)
+ {
+ y = XTX[a * nrows + b]; // bugfix: do NOT want to dereference xindex here
+ fprintf (fff, "%d %d ", a + 1, b + 1);
+ fprintf (fff, "%d ", numsnps);
+ fprintf (fff, "%0.6f\n", y * y_norm_recip);
+ }
+ }
+ fclose (fff);
}
void
-dofast(SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs, int numeigs, FILE *ofile)
+dofast (SNP **snpmarkers, Indiv **indivmarkers, int numsnps, int numindivs,
+ int numeigs, FILE *ofile)
{
- double *eigenvals ;
- double *eigenvecs ;
-
- int nrows = numindivs ;
- int i, j ;
- double y, *xpt ;
- Indiv *indx ;
-
- ZALLOC(eigenvals, numeigs, double) ;
- ZALLOC(eigenvecs, numeigs*nrows, double) ;
+ double *eigenvals;
+ double *eigenvecs;
- kjg_fastpca(snpmarkers, indivmarkers, numsnps, numindivs,
- numeigs, 2*numeigs, numeigs,
- eigenvals, eigenvecs);
+ int nrows = numindivs;
+ int i, j;
+ double y, *xpt;
+ Indiv *indx;
- fprintf(ofile, "%20s ", "#eigvals:") ;
- for (j=0; j<numeigs; j++) {
- fprintf(ofile, "%9.3f ", eigenvals[j]) ;
- }
- fprintf(ofile, "\n") ;
-
- for (i=0; i < nrows ; i++) {
- indx = indivmarkers[i] ;
- fprintf(ofile, "%20s ", indx -> ID) ;
- for (j=0; j<numeigs; j++) {
- y = eigenvecs[i*numeigs+j] ;
- fprintf(ofile, "%10.4f ", y) ;
- }
- fprintf(ofile, "%15s\n", indx -> egroup) ;
- }
+ ZALLOC(eigenvals, numeigs, double);
+ ZALLOC(eigenvecs, numeigs*nrows, double);
- fclose(ofile) ;
-/**
- if (pubmean) {
+ kjg_fastpca (snpmarkers, indivmarkers, numsnps, numindivs, numeigs,
+ 2 * numeigs, numeigs, eigenvals, eigenvecs);
- ZALLOC(wmean, numeg, double) ;
- ZALLOC(elist, numeg, char *) ;
+ fprintf (ofile, "%20s ", "#eigvals:");
+ for (j = 0; j < numeigs; j++)
+ {
+ fprintf (ofile, "%9.3f ", eigenvals[j]);
+ }
+ fprintf (ofile, "\n");
- for (j=0; j<numeigs; j++) {
- xpt = fvecs+j*nrows ;
- calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
- printf ("eig: %d ", j+1) ;
- printf("min: %s %9.3f ", elist[0], wmean[0]) ;
- printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
- printnl() ;
- for (k=0; k<numeg; ++k) {
- printf("%20s ", elist[k]) ;
- printf(" %9.3f\n", wmean[k]) ;
+ for (i = 0; i < nrows; i++)
+ {
+ indx = indivmarkers[i];
+ fprintf (ofile, "%20s ", indx->ID);
+ for (j = 0; j < numeigs; j++)
+ {
+ y = eigenvecs[i * numeigs + j];
+ fprintf (ofile, "%10.4f ", y);
}
- }
+ fprintf (ofile, "%15s\n", indx->egroup);
}
-
-*/
-
- free(eigenvecs) ;
- free(eigenvals) ;
+
+ fclose (ofile);
+ /**
+ if (pubmean) {
+
+ ZALLOC(wmean, numeg, double) ;
+ ZALLOC(elist, numeg, char *) ;
+
+ for (j=0; j<numeigs; j++) {
+ xpt = fvecs+j*nrows ;
+ calcpopmean(wmean, elist, xpt, eglist, numeg, xtypes, nrows) ;
+ printf ("eig: %d ", j+1) ;
+ printf("min: %s %9.3f ", elist[0], wmean[0]) ;
+ printf("max: %s %9.3f ", elist[numeg-1], wmean[numeg-1]) ;
+ printnl() ;
+ for (k=0; k<numeg; ++k) {
+ printf("%20s ", elist[k]) ;
+ printf(" %9.3f\n", wmean[k]) ;
+ }
+ }
+ }
+
+ */
+
+ free (eigenvecs);
+ free (eigenvals);
}
diff --git a/src/regsubs.c b/src/regsubs.c
index ed570a9..fe943ea 100644
--- a/src/regsubs.c
+++ b/src/regsubs.c
@@ -1,428 +1,472 @@
#include "regsubs.h"
-extern int verbose ;
-void squishx(double *xmat, double *mat, int nrow, int oldc, int *cols, int newc) ;
-
-double regressit(double *ans, double *eq, double *rhs, int m, int n)
-{
- double *co, *rr, *ww, *w2 ;
- double vres, vbase, ynum, y, trace ;
- double *traneq ;
- int i, j, k, ret ;
-
- ZALLOC(co, n*n, double) ;
- ZALLOC(rr, n, double) ;
- ZALLOC(ww, m, double) ;
- ZALLOC(w2, m, double) ;
-
- for (i=0; i<m ; i++) {
- for (j=0; j<n ; j++) {
- rr[j] += eq[i*n+j]*rhs[i] ;
- for (k=j; k<n ; k++) {
- co[j*n+k] = co[k*n+j] += eq[i*n+j]*eq[i*n+k];
- }
- }
- }
-
-/**
- y = 1.00001 ;
- for (j=0; j<n ; j++) {
- co[j*n+j] *= y ;
- }
-*/
-
- if (verbose) {
- printf("coeffs:\n") ;
- printmat(co, n, n) ;
- printf("\n\n") ;
- printmat(rr, n, 1) ;
-
- for (i=0; i<n; i++) {
- printf("diag: %3d %9.3f\n", i, co[i*n+i]) ;
- }
-
- fflush(stdout) ;
- }
-
-
- ret = solvit(co, rr, n, ans) ;
- if (ret < 0) return -1000.0 ;
- for (i=0; i<m; i++) {
- ww[i] = rhs[i] - vdot(ans, eq+i*n, n) ;
- }
-
- ynum = (double) m ;
- vres = asum2(ww, m)/ynum ;
- vbase= asum2(rhs, m)/ynum ;
-
-/**
- printf("zzreg %15.9f %15.9f\n", log(vbase), log(vres)) ;
- printmat(rr, 1, n) ;
- printmat(co, n, n) ;
- printf("\n") ;
-*/
-
- free(co) ;
- free(rr) ;
- free(ww) ;
- free(w2) ;
- return ynum*log(vbase/vres) ;
-}
+extern int verbose;
+void
+squishx (double *xmat, double *mat, int nrow, int oldc, int *cols, int newc);
-void regressitall(char **vname, double *eq, double *rhs, int m, int n)
+double
+regressit (double *ans, double *eq, double *rhs, int m, int n)
{
- double *ans ;
- int i, j, k, wt ;
- int npow ;
- int **tab, *tweight, *cols ;
- double *teq ;
- double yscore ;
-
- npow = (int) pow(2.0, (double) n) ;
- ZALLOC(tab, npow, int *) ;
- ZALLOC(tweight, npow, int) ;
- ZALLOC(cols, n, int) ;
-
- for (k=0; k<npow; k++) {
- ZALLOC(tab[k], n, int) ;
- }
- for (k=1; k<npow; k++) {
- add1(tab[k], tab[k-1], n) ;
- tweight[k] = intsum(tab[k], n) ;
- }
- ZALLOC(ans, n, double) ;
- ZALLOC(teq, m*n, double) ;
-
- for (wt=1; wt<=n; ++wt) {
- printf("weight: %d\n", wt) ;
- for (k=0; k<npow; ++k) {
- if(tweight[k] != wt) continue ;
- for (i=0,j=0; i<n; i++) {
- if (tab[k][i] == 0) continue ;
- cols[j] = i ;
- ++j ;
- }
- squishx(teq, eq, m, n, cols, wt) ;
- yscore = regressit(ans, teq, rhs, m, wt) ;
- printf("chisq: %9.3f\n", yscore) ;
- for (i=0,j =0; i<n; i++) {
- if (tab[k][i] == 0) continue ;
- printf("%15s %9.3f\n", vname[i], ans[j]) ;
- ++j ;
+ double *co, *rr, *ww, *w2;
+ double vres, vbase, ynum, y, trace;
+ double *traneq;
+ int i, j, k, ret;
+
+ ZALLOC(co, n*n, double);
+ ZALLOC(rr, n, double);
+ ZALLOC(ww, m, double);
+ ZALLOC(w2, m, double);
+
+ for (i = 0; i < m; i++)
+ {
+ for (j = 0; j < n; j++)
+ {
+ rr[j] += eq[i * n + j] * rhs[i];
+ for (k = j; k < n; k++)
+ {
+ co[j * n + k] = co[k * n + j] += eq[i * n + j] * eq[i * n + k];
+ }
+ }
+ }
+
+ /**
+ y = 1.00001 ;
+ for (j=0; j<n ; j++) {
+ co[j*n+j] *= y ;
}
+ */
+
+ if (verbose)
+ {
+ printf ("coeffs:\n");
+ printmat (co, n, n);
+ printf ("\n\n");
+ printmat (rr, n, 1);
+
+ for (i = 0; i < n; i++)
+ {
+ printf ("diag: %3d %9.3f\n", i, co[i * n + i]);
+ }
+
+ fflush (stdout);
+ }
+
+ ret = solvit (co, rr, n, ans);
+ if (ret < 0)
+ return -1000.0;
+ for (i = 0; i < m; i++)
+ {
+ ww[i] = rhs[i] - vdot (ans, eq + i * n, n);
+ }
+
+ ynum = (double) m;
+ vres = asum2 (ww, m) / ynum;
+ vbase = asum2 (rhs, m) / ynum;
+
+ /**
+ printf("zzreg %15.9f %15.9f\n", log(vbase), log(vres)) ;
+ printmat(rr, 1, n) ;
+ printmat(co, n, n) ;
printf("\n") ;
- }
- }
-
+ */
- free(ans) ;
- free(teq) ;
+ free (co);
+ free (rr);
+ free (ww);
+ free (w2);
+ return ynum * log (vbase / vres);
+}
- for (k=0; k<npow; k++) {
- free(tab[k]) ;
- }
- free(tab) ;
- free(tweight) ;
- free(cols) ;
+void
+regressitall (char **vname, double *eq, double *rhs, int m, int n)
+{
+ double *ans;
+ int i, j, k, wt;
+ int npow;
+ int **tab, *tweight, *cols;
+ double *teq;
+ double yscore;
+
+ npow = (int) pow (2.0, (double) n);
+ ZALLOC(tab, npow, int *);
+ ZALLOC(tweight, npow, int);
+ ZALLOC(cols, n, int);
+
+ for (k = 0; k < npow; k++)
+ {
+ ZALLOC(tab[k], n, int);
+ }
+ for (k = 1; k < npow; k++)
+ {
+ add1 (tab[k], tab[k - 1], n);
+ tweight[k] = intsum (tab[k], n);
+ }
+ ZALLOC(ans, n, double);
+ ZALLOC(teq, m*n, double);
+
+ for (wt = 1; wt <= n; ++wt)
+ {
+ printf ("weight: %d\n", wt);
+ for (k = 0; k < npow; ++k)
+ {
+ if (tweight[k] != wt)
+ continue;
+ for (i = 0, j = 0; i < n; i++)
+ {
+ if (tab[k][i] == 0)
+ continue;
+ cols[j] = i;
+ ++j;
+ }
+ squishx (teq, eq, m, n, cols, wt);
+ yscore = regressit (ans, teq, rhs, m, wt);
+ printf ("chisq: %9.3f\n", yscore);
+ for (i = 0, j = 0; i < n; i++)
+ {
+ if (tab[k][i] == 0)
+ continue;
+ printf ("%15s %9.3f\n", vname[i], ans[j]);
+ ++j;
+ }
+ printf ("\n");
+ }
+ }
+
+ free (ans);
+ free (teq);
+
+ for (k = 0; k < npow; k++)
+ {
+ free (tab[k]);
+ }
+ free (tab);
+ free (tweight);
+ free (cols);
}
-void add1(int *a, int *b, int n)
+void
+add1 (int *a, int *b, int n)
// b is 0, 1 vector as base 2 integer. a = b + 1
{
- if (n==0) return ;
- copyiarr(b, a, n) ;
- a[n-1] = b[n-1] + 1 ;
- if (a[n-1] == 2) {
- a[n-1] = 0 ;
- add1(a, b, n-1) ;
- }
+ if (n == 0)
+ return;
+ copyiarr (b, a, n);
+ a[n - 1] = b[n - 1] + 1;
+ if (a[n - 1] == 2)
+ {
+ a[n - 1] = 0;
+ add1 (a, b, n - 1);
+ }
}
// now logistic regression stuff
double
-logregressit(double *ans, double *eq, double **rhs, int neq, int nv)
+logregressit (double *ans, double *eq, double **rhs, int neq, int nv)
// return log likelihood NOT chi-sq
{
- double *p, *z, *q ;
- double *n0, *n1, *tans ;
- double *grad, *hess, rr[2] ;
- double y0, y1, y, ylike, ybase, yold ;
- int i, j ;
- int iter, numiter = 10 ;
- int ret ;
-
- ZALLOC(p, neq, double) ;
- ZALLOC(q, neq, double) ;
- ZALLOC(z, neq, double) ;
- ZALLOC(n0, neq, double) ;
- ZALLOC(n1, neq, double) ;
- ZALLOC(tans, neq, double) ;
- ZALLOC(grad, nv, double) ;
- ZALLOC(hess, nv*nv, double) ;
-
-
- for (i=0; i<neq; i++) {
- y0 = n0[i] = rhs[i][0] ;
- y1 = n1[i] = rhs[i][1] ;
- y0 += 1.0 ;
- y1 += 1.0 ;
- y = y1/(y0+y1) ;
- y = MIN(y, 0.75) ;
- y = MAX(y, 0.25) ;
+ double *p, *z, *q;
+ double *n0, *n1, *tans;
+ double *grad, *hess, rr[2];
+ double y0, y1, y, ylike, ybase, yold;
+ int i, j;
+ int iter, numiter = 10;
+ int ret;
+
+ ZALLOC(p, neq, double);
+ ZALLOC(q, neq, double);
+ ZALLOC(z, neq, double);
+ ZALLOC(n0, neq, double);
+ ZALLOC(n1, neq, double);
+ ZALLOC(tans, neq, double);
+ ZALLOC(grad, nv, double);
+ ZALLOC(hess, nv*nv, double);
+
+ for (i = 0; i < neq; i++)
+ {
+ y0 = n0[i] = rhs[i][0];
+ y1 = n1[i] = rhs[i][1];
+ y0 += 1.0;
+ y1 += 1.0;
+ y = y1 / (y0 + y1);
+ y = MIN(y, 0.75);
+ y = MAX(y, 0.25);
// may need changing for some problems
- p[i] = y ;
- }
- y0 = asum(n0, neq) ;
- y1 = asum(n1, neq) ;
- y = y1/(y0+y1) ;
- for (i=0; i<neq; i++) {
- p[i] = (p[i] + y)/2.0 ;
- if (p[i]<0.0) fatalx("bugbug\n") ;
- if (p[i]>1.0) fatalx("bugbug\n") ;
- }
-
- if (verbose) {
- vzero(rr, 2) ;
- for (j=0; j<neq; j++) {
- vvp(grad, grad, eq+j*nv, nv) ;
- vvp(rr, rr, rhs[j], 2) ;
- addouter(hess, eq+j*nv, nv) ;
- }
- y = 1.0 / (double) neq ;
- vst(grad, grad, y, nv) ;
- vst(rr, rr, y, 2) ;
- vst(hess, hess, y, nv*nv) ;
- printf("## averages\n") ;
- printmat(grad, 1, nv) ;
- printmat(rr, 1, 2) ;
- printmat(hess, nv, nv) ;
- }
-
- ptoz(p, z, neq) ;
- regressit(ans, eq, z, neq, nv) ;
- for (j=0; j<neq; j++) {
- z[j] = vdot(eq+j*nv, ans, nv) ;
- }
- ybase = zlike(eq, n0, n1, ans, neq, nv) ;
- ztop(p, z, neq) ;
-
- calcgh(grad, hess, eq, z, n0, n1, neq, nv) ;
- y = .001 ;
- for (i=0; i<nv; i++) {
- if (!verbose) break ;
- copyarr(ans, tans, nv) ;
- tans[i] += y ;
- ylike = zlike(eq, n0, n1, tans, neq, nv) ;
- printf("zzgrad %3d %12.6f %12.6f\n",i, ylike-ybase, grad[i]*y) ;
- }
-
- for (iter=1; iter <= numiter; ++iter) {
- calcgh(grad, hess, eq, z, n0, n1, neq, nv) ;
- ret = solvit(hess, grad, nv, tans) ;
- if (ret < 0) return -1000.0 ;
- if (verbose) {
- printf("zzzz\n") ;
- printmat(ans, 1, nv) ;
- printmat(grad, 1, nv) ;
- printmat(hess, nv, nv) ;
- printmat(tans, 1 , nv) ;
- printf("\n\n") ;
- }
- vvp(ans, ans, tans, nv) ;
- for (j=0; j<neq; j++) {
- z[j] = vdot(eq+j*nv, ans, nv) ;
- }
- ylike = zlike(eq, n0, n1, ans, neq, nv) ;
-/**
- if (verbose) {
- printf("iter: %3d llike: %15.9f incr: %15.9f\n", iter, ylike, ylike-ybase) ;
- printmat(ans, 1, nv) ;
- }
-*/
- if ((iter>1) && (ylike<(yold+.0001))) break ;
- yold = ylike ;
- }
-
- free(p) ;
- free(q) ;
- free(z) ;
- free(n0) ;
- free(n1) ;
- free(tans) ;
- free(grad) ;
- free(hess) ;
-
- return ylike ;
+ p[i] = y;
+ }
+ y0 = asum (n0, neq);
+ y1 = asum (n1, neq);
+ y = y1 / (y0 + y1);
+ for (i = 0; i < neq; i++)
+ {
+ p[i] = (p[i] + y) / 2.0;
+ if (p[i] < 0.0)
+ fatalx ("bugbug\n");
+ if (p[i] > 1.0)
+ fatalx ("bugbug\n");
+ }
+
+ if (verbose)
+ {
+ vzero (rr, 2);
+ for (j = 0; j < neq; j++)
+ {
+ vvp (grad, grad, eq + j * nv, nv);
+ vvp (rr, rr, rhs[j], 2);
+ addouter (hess, eq + j * nv, nv);
+ }
+ y = 1.0 / (double) neq;
+ vst (grad, grad, y, nv);
+ vst (rr, rr, y, 2);
+ vst (hess, hess, y, nv * nv);
+ printf ("## averages\n");
+ printmat (grad, 1, nv);
+ printmat (rr, 1, 2);
+ printmat (hess, nv, nv);
+ }
+
+ ptoz (p, z, neq);
+ regressit (ans, eq, z, neq, nv);
+ for (j = 0; j < neq; j++)
+ {
+ z[j] = vdot (eq + j * nv, ans, nv);
+ }
+ ybase = zlike (eq, n0, n1, ans, neq, nv);
+ ztop (p, z, neq);
+
+ calcgh (grad, hess, eq, z, n0, n1, neq, nv);
+ y = .001;
+ for (i = 0; i < nv; i++)
+ {
+ if (!verbose)
+ break;
+ copyarr (ans, tans, nv);
+ tans[i] += y;
+ ylike = zlike (eq, n0, n1, tans, neq, nv);
+ printf ("zzgrad %3d %12.6f %12.6f\n", i, ylike - ybase, grad[i] * y);
+ }
+
+ for (iter = 1; iter <= numiter; ++iter)
+ {
+ calcgh (grad, hess, eq, z, n0, n1, neq, nv);
+ ret = solvit (hess, grad, nv, tans);
+ if (ret < 0)
+ return -1000.0;
+ if (verbose)
+ {
+ printf ("zzzz\n");
+ printmat (ans, 1, nv);
+ printmat (grad, 1, nv);
+ printmat (hess, nv, nv);
+ printmat (tans, 1, nv);
+ printf ("\n\n");
+ }
+ vvp (ans, ans, tans, nv);
+ for (j = 0; j < neq; j++)
+ {
+ z[j] = vdot (eq + j * nv, ans, nv);
+ }
+ ylike = zlike (eq, n0, n1, ans, neq, nv);
+ /**
+ if (verbose) {
+ printf("iter: %3d llike: %15.9f incr: %15.9f\n", iter, ylike, ylike-ybase) ;
+ printmat(ans, 1, nv) ;
+ }
+ */
+ if ((iter > 1) && (ylike < (yold + .0001)))
+ break;
+ yold = ylike;
+ }
+
+ free (p);
+ free (q);
+ free (z);
+ free (n0);
+ free (n1);
+ free (tans);
+ free (grad);
+ free (hess);
+
+ return ylike;
}
-void ptoz(double *p, double *z, int n)
+void
+ptoz (double *p, double *z, int n)
{
- double *w1, *w2 ;
+ double *w1, *w2;
- ZALLOC(w1, n, double) ;
- ZALLOC(w2, n, double) ;
+ ZALLOC(w1, n, double);
+ ZALLOC(w2, n, double);
- vst(w2, p, -1.0, n) ;
- vsp(w2, w2, 1.0, n) ; // q
- vvd(w1, p, w2, n) ;
- vlog(z, w1, n) ;
- free(w1) ; free(w2) ;
+ vst (w2, p, -1.0, n);
+ vsp (w2, w2, 1.0, n); // q
+ vvd (w1, p, w2, n);
+ vlog (z, w1, n);
+ free (w1);
+ free (w2);
}
-void ztop(double *p, double *z, int n)
+void
+ztop (double *p, double *z, int n)
{
- double *ww, *w1 ;
+ double *ww, *w1;
- ZALLOC(ww, n, double) ;
- ZALLOC(w1, n, double) ;
+ ZALLOC(ww, n, double);
+ ZALLOC(w1, n, double);
- vexp(ww, z, n) ;
- vsp(w1, ww, 1.0, n) ; // 1 + e^z
- vvd(p, ww, w1, n) ; // p
+ vexp (ww, z, n);
+ vsp (w1, ww, 1.0, n); // 1 + e^z
+ vvd (p, ww, w1, n); // p
- free(ww) ;
- free(w1) ;
+ free (ww);
+ free (w1);
}
void
-calcgh(double *grad, double *hess, double *eq, double *z,
- double *n0, double *n1, int neq, int nv)
+calcgh (double *grad, double *hess, double *eq, double *z, double *n0,
+ double *n1, int neq, int nv)
{
-
- double *ww, *w1, *w2, *x0, *x1 ;
- int j ;
-
- ZALLOC(ww, neq, double) ;
- ZALLOC(w1, neq, double) ;
- ZALLOC(w2, neq, double) ;
- ZALLOC(x0, neq, double) ;
- ZALLOC(x1, neq, double) ;
-
- vexp(ww, z, neq) ;
- vsp(w1, ww, 1.0, neq) ;
- vvt(w2, w1, w1, neq) ;
- vvt(x0, n0, ww, neq) ;
- vvm(x0, x0, n1, neq) ;
- vvd(x0, x0, w1, neq) ;
-
- vvp(x1, n0, n1, neq) ;
- vvt(x1, x1, ww, neq) ;
- vvd(x1, x1, w2, neq) ;
-
- vzero(grad, nv) ;
- vzero(hess, nv*nv) ;
-
- for (j=0; j<neq; j++) {
- vst(ww, eq+j*nv, x0[j], nv) ;
- vvm(grad, grad, ww, nv) ;
- vst(ww, eq+j*nv, sqrt(x1[j]), nv) ;
- addouter(hess, ww, nv) ; // actually -hess
- }
- free(ww) ;
- free(w1) ;
- free(w2) ;
- free(x0) ;
- free(x1) ;
+ double *ww, *w1, *w2, *x0, *x1;
+ int j;
+
+ ZALLOC(ww, neq, double);
+ ZALLOC(w1, neq, double);
+ ZALLOC(w2, neq, double);
+ ZALLOC(x0, neq, double);
+ ZALLOC(x1, neq, double);
+
+ vexp (ww, z, neq);
+ vsp (w1, ww, 1.0, neq);
+ vvt (w2, w1, w1, neq);
+ vvt (x0, n0, ww, neq);
+ vvm (x0, x0, n1, neq);
+ vvd (x0, x0, w1, neq);
+
+ vvp (x1, n0, n1, neq);
+ vvt (x1, x1, ww, neq);
+ vvd (x1, x1, w2, neq);
+
+ vzero (grad, nv);
+ vzero (hess, nv * nv);
+
+ for (j = 0; j < neq; j++)
+ {
+ vst (ww, eq + j * nv, x0[j], nv);
+ vvm (grad, grad, ww, nv);
+ vst (ww, eq + j * nv, sqrt (x1[j]), nv);
+ addouter (hess, ww, nv); // actually -hess
+ }
+ free (ww);
+ free (w1);
+ free (w2);
+ free (x0);
+ free (x1);
}
-double zlike(double *eq, double *n0, double *n1,
- double *ans, int neq, int nv)
+double
+zlike (double *eq, double *n0, double *n1, double *ans, int neq, int nv)
{
- double *z, *p, *q ;
- double ylike, pprob, qprob, y0, y1, ybase ;
- int j ;
-
- ZALLOC(z, neq, double) ;
- ZALLOC(p, neq, double) ;
- ZALLOC(q, neq, double) ;
-
- y0 = asum(n0, neq) ;
- y1 = asum(n1, neq) ;
-
- y0 += 1.0e-10 ;
- y1 += 1.0e-10 ;
-
- pprob = y1/(y0+y1) ;
- qprob = y0/(y0+y1) ;
-
- ybase = y1*log(pprob) + y0*log(qprob) ;
-
- for (j=0; j<neq; j++) {
- z[j] = vdot(eq+j*nv, ans, nv) ;
- }
- ztop(p, z, neq) ;
- vst(q, p, -1.0, neq) ;
- vsp(q, q, 1.0, neq) ;
- ylike = vldot(n1, p, neq) + vldot(n0, q, neq) ;
- ylike -= ybase ;
- free(z) ;
- free(p) ;
- free(q) ;
- return ylike ;
+ double *z, *p, *q;
+ double ylike, pprob, qprob, y0, y1, ybase;
+ int j;
+
+ ZALLOC(z, neq, double);
+ ZALLOC(p, neq, double);
+ ZALLOC(q, neq, double);
+
+ y0 = asum (n0, neq);
+ y1 = asum (n1, neq);
+
+ y0 += 1.0e-10;
+ y1 += 1.0e-10;
+
+ pprob = y1 / (y0 + y1);
+ qprob = y0 / (y0 + y1);
+
+ ybase = y1 * log (pprob) + y0 * log (qprob);
+
+ for (j = 0; j < neq; j++)
+ {
+ z[j] = vdot (eq + j * nv, ans, nv);
+ }
+ ztop (p, z, neq);
+ vst (q, p, -1.0, neq);
+ vsp (q, q, 1.0, neq);
+ ylike = vldot (n1, p, neq) + vldot (n0, q, neq);
+ ylike -= ybase;
+ free (z);
+ free (p);
+ free (q);
+ return ylike;
}
-double logrscore(double *eq, double **rhs, int neq, int nv)
+double
+logrscore (double *eq, double **rhs, int neq, int nv)
// test significance of last regressor
{
- double *teq, *ans ;
- double y1, y2, ychi ;
- int i ;
+ double *teq, *ans;
+ double y1, y2, ychi;
+ int i;
- ZALLOC(teq, neq*nv, double) ;
- ZALLOC(ans, nv, double) ;
+ ZALLOC(teq, neq*nv, double);
+ ZALLOC(ans, nv, double);
- squish(teq, eq, neq, nv, nv-1) ;
+ squish (teq, eq, neq, nv, nv - 1);
- y1 = logregressit(ans, teq, rhs, neq, nv-1) ;
- y2 = logregressit(ans, eq, rhs, neq, nv) ;
+ y1 = logregressit (ans, teq, rhs, neq, nv - 1);
+ y2 = logregressit (ans, eq, rhs, neq, nv);
- ychi = 2.0*(y2-y1) ;
+ ychi = 2.0 * (y2 - y1);
- free(teq) ;
- free(ans) ;
+ free (teq);
+ free (ans);
- return ychi ;
+ return ychi;
}
-void squish(double *xmat, double *mat, int nrow, int oldc, int newc)
+void
+squish (double *xmat, double *mat, int nrow, int oldc, int newc)
// in place legal !
{
- int i ;
- double *ww ;
+ int i;
+ double *ww;
- ZALLOC(ww, nrow*newc, double) ;
+ ZALLOC(ww, nrow*newc, double);
- for (i=0; i<nrow; i++) {
- copyarr(mat+i*oldc, ww+i*newc, newc) ;
- }
+ for (i = 0; i < nrow; i++)
+ {
+ copyarr (mat + i * oldc, ww + i * newc, newc);
+ }
- copyarr(ww, xmat, nrow*newc) ;
- free(ww) ;
+ copyarr (ww, xmat, nrow * newc);
+ free (ww);
}
-void squishx(double *xmat, double *mat, int nrow, int oldc, int *cols, int newc)
+void
+squishx (double *xmat, double *mat, int nrow, int oldc, int *cols, int newc)
// copy cols of mat to xmat
{
- int i, j, k ;
- for (i=0; i<nrow; i++) {
- for (j=0; j<newc; ++j) {
- k = cols[j] ;
- xmat[i*newc+j] = mat[i*oldc+k] ;
- }
- }
+ int i, j, k;
+ for (i = 0; i < nrow; i++)
+ {
+ for (j = 0; j < newc; ++j)
+ {
+ k = cols[j];
+ xmat[i * newc + j] = mat[i * oldc + k];
+ }
+ }
}
void
-calcres(double *res, double *ans, double *eq, double *rhs,
- int neq, int nv)
+calcres (double *res, double *ans, double *eq, double *rhs, int neq, int nv)
/**
calculate residual
-*/
+ */
{
- int i ;
- for (i=0; i<neq ; i++) {
- res[i] = rhs[i] - vdot(eq+i*nv, ans, nv) ;
- }
+ int i;
+ for (i = 0; i < neq; i++)
+ {
+ res[i] = rhs[i] - vdot (eq + i * nv, ans, nv);
+ }
}
diff --git a/src/smartpca.gmon.out b/src/smartpca.gmon.out
deleted file mode 100644
index e732bc9..0000000
Binary files a/src/smartpca.gmon.out and /dev/null differ
diff --git a/src/smartpca.gmon.profile b/src/smartpca.gmon.profile
deleted file mode 100644
index c9b8d18..0000000
--- a/src/smartpca.gmon.profile
+++ /dev/null
@@ -1,863 +0,0 @@
-Flat profile:
-
-Each sample counts as 0.01 seconds.
- % cumulative self self total
- time seconds seconds calls s/call s/call name
- 15.99 2.49 2.49 320000000 0.00 0.00 rbuff
- 14.58 4.76 2.27 40000 0.00 0.00 vdot
- 13.49 6.86 2.10 320000000 0.00 0.00 getgtypes
- 12.40 8.79 1.93 printevecs
- 10.28 10.39 1.60 240000000 0.00 0.00 getggval
- 8.86 11.77 1.38 120000 0.00 0.00 kjg_geno_get_normalized_row
- 3.98 12.39 0.62 20000000 0.00 0.00 wbuff
- 3.92 13.00 0.61 1 0.61 1.73 ineigenstrat
- 3.34 13.52 0.52 220000000 0.00 0.00 getgval
- 1.93 13.82 0.30 fvadjust
- 1.93 14.12 0.30 10000 0.00 0.00 getgall
- 1.16 14.30 0.18 1 0.18 0.18 unsetgval
- 1.09 14.47 0.17 10000 0.00 0.00 numvalidgt
- 1.03 14.63 0.16 10000 0.00 0.00 numvalidgtx
- 1.03 14.79 0.16 getcolxz
- 0.90 14.93 0.14 10000 0.00 0.00 floatit
- 0.71 15.04 0.11 40000000 0.00 0.00 checkxval
- 0.71 15.15 0.11 34005 0.00 0.00 splitupwxbuff
- 0.71 15.26 0.11 10020 0.00 0.00 vst
- 0.64 15.36 0.10 1 0.10 0.40 numvalidgtallind
- 0.45 15.43 0.07 20000000 0.00 0.00 putgtypes
- 0.26 15.47 0.04 LAPACKE_dge_trans
- 0.19 15.50 0.03 30001 0.00 0.00 cclear
- 0.19 15.53 0.03 10000 0.00 0.00 getrawcol
- 0.06 15.54 0.01 100 0.00 0.00 vlmaxmin
- 0.06 15.55 0.01 1 0.01 0.01 freeped
- 0.06 15.56 0.01 LAPACKE_dge_nancheck
- 0.06 15.57 0.01 hashit
- 0.00 15.57 0.00 142006 0.00 0.00 freestring
- 0.00 15.57 0.00 64608 0.00 0.00 compiarr
- 0.00 15.57 0.00 34005 0.00 0.00 freeup
- 0.00 15.57 0.00 34005 0.00 0.00 splitup
- 0.00 15.57 0.00 30101 0.00 0.00 nnint
- 0.00 15.57 0.00 24000 0.00 0.00 setskipit
- 0.00 15.57 0.00 20001 0.00 0.00 copyiarr
- 0.00 15.57 0.00 20000 0.00 0.00 intsum
- 0.00 15.57 0.00 20000 0.00 0.00 kjg_gsl_ran_ugaussian_pair
- 0.00 15.57 0.00 20000 0.00 0.00 mknn
- 0.00 15.57 0.00 20000 0.00 0.00 mkupper
- 0.00 15.57 0.00 10002 0.00 0.00 ivclear
- 0.00 15.57 0.00 10001 0.00 0.00 NPisnumber
- 0.00 15.57 0.00 10001 0.00 0.00 isnumword
- 0.00 15.57 0.00 10001 0.00 0.00 ivzero
- 0.00 15.57 0.00 10000 0.00 0.00 clearsnp
- 0.00 15.57 0.00 10000 0.00 0.00 setsdpos
- 0.00 15.57 0.00 10000 0.00 0.00 str2chrom
- 0.00 15.57 0.00 2003 0.00 0.00 vclear
- 0.00 15.57 0.00 2000 0.00 0.00 indxindex
- 0.00 15.57 0.00 2000 0.00 0.00 vzero
- 0.00 15.57 0.00 480 0.00 0.00 kjg_geno_get_normalized_rows
- 0.00 15.57 0.00 97 0.00 0.00 findpname
- 0.00 15.57 0.00 55 0.00 0.00 getint
- 0.00 15.57 0.00 31 0.00 0.00 getstring
- 0.00 15.57 0.00 13 0.00 0.00 get_ncols
- 0.00 15.57 0.00 13 0.00 0.00 get_nrows
- 0.00 15.57 0.00 11 0.00 0.00 copyarr
- 0.00 15.57 0.00 11 0.00 0.00 getdbl
- 0.00 15.57 0.00 10 0.00 0.00 asum2
- 0.00 15.57 0.00 10 0.00 0.12 kjg_fpca_XTXA
- 0.00 15.57 0.00 10 0.00 0.00 kjg_gsl_dgeqrf
- 0.00 15.57 0.00 10 0.00 0.00 kjg_gsl_dorgqr
- 0.00 15.57 0.00 10 0.00 0.00 kjg_gsl_matrix_QR
- 0.00 15.57 0.00 8 0.00 0.00 fnwhite
- 0.00 15.57 0.00 6 0.00 0.00 openit
- 0.00 15.57 0.00 4 0.00 0.00 first_word
- 0.00 15.57 0.00 4 0.00 0.00 fwhite
- 0.00 15.57 0.00 4 0.00 0.00 indxstring
- 0.00 15.57 0.00 4 0.00 0.00 stripcomment
- 0.00 15.57 0.00 4 0.00 0.00 striptrail
- 0.00 15.57 0.00 4 0.00 0.00 upstring
- 0.00 15.57 0.00 2 0.00 0.02 getsizex
- 0.00 15.57 0.00 2 0.00 0.00 ispedfile
- 0.00 15.57 0.00 2 0.00 0.00 kjg_gsl_SVD
- 0.00 15.57 0.00 2 0.00 0.00 nextmesh
- 0.00 15.57 0.00 1 0.00 0.00 checksize
- 0.00 15.57 0.00 1 0.00 0.00 clearepath
- 0.00 15.57 0.00 1 0.00 0.00 clearind
- 0.00 15.57 0.00 1 0.00 0.00 cleartg
- 0.00 15.57 0.00 1 0.00 0.00 copyiparr
- 0.00 15.57 0.00 1 0.00 0.00 dobadsnps
- 0.00 15.57 0.00 1 0.00 0.00 dostrsub
- 0.00 15.57 0.00 1 0.00 0.00 freesnpindex
- 0.00 15.57 0.00 1 0.00 1.74 getgenos
- 0.00 15.57 0.00 1 0.00 0.03 getindivs
- 0.00 15.57 0.00 1 0.00 0.08 getsnps
- 0.00 15.57 0.00 1 0.00 0.00 initarray_2Ddouble
- 0.00 15.57 0.00 1 0.00 0.00 ipsortit
- 0.00 15.57 0.00 1 0.00 0.00 ipsortitp
- 0.00 15.57 0.00 1 0.00 0.00 isbedfile
- 0.00 15.57 0.00 1 0.00 0.00 iseigenstrat
- 0.00 15.57 0.00 1 0.00 0.00 ismapfile
- 0.00 15.57 0.00 1 0.00 0.00 ispack
- 0.00 15.57 0.00 1 0.00 1.38 kjg_fpca
- 0.00 15.57 0.00 1 0.00 0.12 kjg_fpca_XA
- 0.00 15.57 0.00 1 0.00 0.12 kjg_fpca_XTB
- 0.00 15.57 0.00 1 0.00 0.00 kjg_gsl_ran_ugaussian_matrix
- 0.00 15.57 0.00 1 0.00 0.00 kjg_gsl_rng_init
- 0.00 15.57 0.00 1 0.00 0.00 loadindx
- 0.00 15.57 0.00 1 0.00 0.00 loadsnps
- 0.00 15.57 0.00 1 0.00 0.46 loadsnpx
- 0.00 15.57 0.00 1 0.00 0.00 makeeglist
- 0.00 15.57 0.00 1 0.00 0.00 numfakes
- 0.00 15.57 0.00 1 0.00 0.00 openpars
- 0.00 15.57 0.00 1 0.00 0.00 pcheck
- 0.00 15.57 0.00 1 0.00 0.01 readinddata
- 0.00 15.57 0.00 1 0.00 0.03 readsnpdata
- 0.00 15.57 0.00 1 0.00 0.00 rmsnps
- 0.00 15.57 0.00 1 0.00 0.00 set_ind_mask
- 0.00 15.57 0.00 1 0.00 0.00 setfvecs
- 0.00 15.57 0.00 1 0.00 0.18 setgval
- 0.00 15.57 0.00 1 0.00 0.00 setomode
- 0.00 15.57 0.00 1 0.00 0.00 setorder
- 0.00 15.57 0.00 1 0.00 0.00 setstatus
- 0.00 15.57 0.00 1 0.00 0.00 setstatusv
- 0.00 15.57 0.00 1 0.00 0.00 transpose
- 0.00 15.57 0.00 1 0.00 0.00 vinvert
- 0.00 15.57 0.00 1 0.00 0.00 vsqrt
- 0.00 15.57 0.00 1 0.00 0.00 writepars
-
- % the percentage of the total running time of the
-time program used by this function.
-
-cumulative a running sum of the number of seconds accounted
- seconds for by this function and those listed above it.
-
- self the number of seconds accounted for by this
-seconds function alone. This is the major sort for this
- listing.
-
-calls the number of times this function was invoked, if
- this function is profiled, else blank.
-
- self the average number of milliseconds spent in this
-ms/call function per call, if this function is profiled,
- else blank.
-
- total the average number of milliseconds spent in this
-ms/call function and its descendents per call, if this
- function is profiled, else blank.
-
-name the name of the function. This is the minor sort
- for this listing. The index shows the location of
- the function in the gprof listing. If the index is
- in parenthesis it shows where it would appear in
- the gprof listing if it were to be printed.
-
- Call graph (explanation follows)
-
-
-granularity: each sample hit covers 2 byte(s) for 0.06% of 15.57 seconds
-
-index % time self children called name
- <spontaneous>
-[1] 62.7 1.93 7.83 printevecs [1]
- 0.52 4.62 220000000/220000000 getgval [2]
- 2.27 0.00 40000/40000 vdot [7]
- 0.13 0.29 20000000/240000000 getggval [3]
- 0.00 0.00 1/1 setfvecs [46]
- 0.00 0.00 1/1 vsqrt [120]
- 0.00 0.00 1/1 vinvert [119]
------------------------------------------------
- 0.52 4.62 220000000/220000000 printevecs [1]
-[2] 33.0 0.52 4.62 220000000 getgval [2]
- 1.47 3.16 220000000/240000000 getggval [3]
------------------------------------------------
- 0.13 0.29 20000000/240000000 printevecs [1]
- 1.47 3.16 220000000/240000000 getgval [2]
-[3] 32.4 1.60 3.44 240000000 getggval [3]
- 1.58 1.87 240000000/320000000 getgtypes [5]
------------------------------------------------
- <spontaneous>
-[4] 30.3 0.00 4.71 main [4]
- 0.00 1.74 1/1 getgenos [8]
- 0.00 1.38 1/1 kjg_fpca [12]
- 0.00 0.46 1/1 loadsnpx [18]
- 0.16 0.29 10000/10000 numvalidgtx [19]
- 0.10 0.30 1/1 numvalidgtallind [20]
- 0.00 0.18 1/1 setgval [24]
- 0.00 0.08 1/1 getsnps [33]
- 0.00 0.03 1/1 getindivs [38]
- 0.00 0.00 10000/30101 nnint [55]
- 0.00 0.00 1/1 setomode [114]
- 0.00 0.00 1/1 setstatus [116]
- 0.00 0.00 1/1 makeeglist [108]
- 0.00 0.00 1/1 rmsnps [112]
- 0.00 0.00 1/1 loadindx [106]
- 0.00 0.00 1/1 transpose [118]
------------------------------------------------
- 0.13 0.16 20000000/320000000 ineigenstrat [9]
- 0.13 0.16 20000000/320000000 getrawcol [21]
- 0.13 0.16 20000000/320000000 numvalidgt [17]
- 0.13 0.16 20000000/320000000 numvalidgtx [19]
- 1.58 1.87 240000000/320000000 getggval [3]
-[5] 29.5 2.10 2.49 320000000 getgtypes [5]
- 2.49 0.00 320000000/320000000 rbuff [6]
------------------------------------------------
- 2.49 0.00 320000000/320000000 getgtypes [5]
-[6] 16.0 2.49 0.00 320000000 rbuff [6]
------------------------------------------------
- 2.27 0.00 40000/40000 printevecs [1]
-[7] 14.6 2.27 0.00 40000 vdot [7]
------------------------------------------------
- 0.00 1.74 1/1 main [4]
-[8] 11.2 0.00 1.74 1 getgenos [8]
- 0.61 1.12 1/1 ineigenstrat [9]
- 0.01 0.00 1/1 freeped [42]
- 0.00 0.00 1/1 iseigenstrat [50]
- 0.00 0.00 1/1 checksize [91]
- 0.00 0.00 1/2 ispedfile [88]
- 0.00 0.00 1/1 isbedfile [101]
- 0.00 0.00 1/1 ispack [103]
------------------------------------------------
- 0.61 1.12 1/1 getgenos [8]
-[9] 11.1 0.61 1.12 1 ineigenstrat [9]
- 0.07 0.62 20000000/20000000 putgtypes [15]
- 0.13 0.16 20000000/320000000 getgtypes [5]
- 0.11 0.00 40000000/40000000 checkxval [29]
- 0.00 0.03 10000/34005 splitup [30]
- 0.00 0.00 1/1 clearepath [51]
- 0.00 0.00 10000/34005 freeup [54]
- 0.00 0.00 1/30101 nnint [55]
- 0.00 0.00 1/6 openit [81]
- 0.00 0.00 1/142006 freestring [52]
------------------------------------------------
- 1.38 0.00 120000/120000 kjg_geno_get_normalized_rows [11]
-[10] 8.9 1.38 0.00 120000 kjg_geno_get_normalized_row [10]
------------------------------------------------
- 0.00 0.12 40/480 kjg_fpca_XA [27]
- 0.00 0.12 40/480 kjg_fpca_XTB [28]
- 0.00 1.15 400/480 kjg_fpca_XTXA [13]
-[11] 8.9 0.00 1.38 480 kjg_geno_get_normalized_rows [11]
- 1.38 0.00 120000/120000 kjg_geno_get_normalized_row [10]
------------------------------------------------
- 0.00 1.38 1/1 main [4]
-[12] 8.9 0.00 1.38 1 kjg_fpca [12]
- 0.00 1.15 10/10 kjg_fpca_XTXA [13]
- 0.00 0.12 1/1 kjg_fpca_XA [27]
- 0.00 0.12 1/1 kjg_fpca_XTB [28]
- 0.00 0.00 10/10 kjg_gsl_matrix_QR [79]
- 0.00 0.00 2/2 kjg_gsl_SVD [89]
- 0.00 0.00 1/13 get_nrows [73]
- 0.00 0.00 1/13 get_ncols [72]
- 0.00 0.00 1/1 kjg_gsl_rng_init [105]
- 0.00 0.00 1/1 kjg_gsl_ran_ugaussian_matrix [104]
------------------------------------------------
- 0.00 1.15 10/10 kjg_fpca [12]
-[13] 7.4 0.00 1.15 10 kjg_fpca_XTXA [13]
- 0.00 1.15 400/480 kjg_geno_get_normalized_rows [11]
- 0.00 0.00 10/13 get_ncols [72]
- 0.00 0.00 10/13 get_nrows [73]
------------------------------------------------
- <spontaneous>
-[14] 4.7 0.16 0.57 getcolxz [14]
- 0.03 0.29 10000/10000 getrawcol [21]
- 0.14 0.00 10000/10000 floatit [26]
- 0.11 0.00 10000/10020 vst [32]
------------------------------------------------
- 0.07 0.62 20000000/20000000 ineigenstrat [9]
-[15] 4.4 0.07 0.62 20000000 putgtypes [15]
- 0.62 0.00 20000000/20000000 wbuff [16]
------------------------------------------------
- 0.62 0.00 20000000/20000000 putgtypes [15]
-[16] 4.0 0.62 0.00 20000000 wbuff [16]
------------------------------------------------
- 0.17 0.29 10000/10000 loadsnpx [18]
-[17] 2.9 0.17 0.29 10000 numvalidgt [17]
- 0.13 0.16 20000000/320000000 getgtypes [5]
------------------------------------------------
- 0.00 0.46 1/1 main [4]
-[18] 2.9 0.00 0.46 1 loadsnpx [18]
- 0.17 0.29 10000/10000 numvalidgt [17]
------------------------------------------------
- 0.16 0.29 10000/10000 main [4]
-[19] 2.9 0.16 0.29 10000 numvalidgtx [19]
- 0.13 0.16 20000000/320000000 getgtypes [5]
------------------------------------------------
- 0.10 0.30 1/1 main [4]
-[20] 2.6 0.10 0.30 1 numvalidgtallind [20]
- 0.30 0.00 10000/10000 getgall [23]
- 0.00 0.00 1/10001 ivzero [65]
------------------------------------------------
- 0.03 0.29 10000/10000 getcolxz [14]
-[21] 2.0 0.03 0.29 10000 getrawcol [21]
- 0.13 0.16 20000000/320000000 getgtypes [5]
------------------------------------------------
- <spontaneous>
-[22] 1.9 0.30 0.00 fvadjust [22]
------------------------------------------------
- 0.30 0.00 10000/10000 numvalidgtallind [20]
-[23] 1.9 0.30 0.00 10000 getgall [23]
------------------------------------------------
- 0.00 0.18 1/1 main [4]
-[24] 1.2 0.00 0.18 1 setgval [24]
- 0.18 0.00 1/1 unsetgval [25]
- 0.00 0.00 1/2003 vclear [68]
- 0.00 0.00 1/1 initarray_2Ddouble [98]
- 0.00 0.00 1/1 set_ind_mask [113]
------------------------------------------------
- 0.18 0.00 1/1 setgval [24]
-[25] 1.2 0.18 0.00 1 unsetgval [25]
------------------------------------------------
- 0.14 0.00 10000/10000 getcolxz [14]
-[26] 0.9 0.14 0.00 10000 floatit [26]
------------------------------------------------
- 0.00 0.12 1/1 kjg_fpca [12]
-[27] 0.7 0.00 0.12 1 kjg_fpca_XA [27]
- 0.00 0.12 40/480 kjg_geno_get_normalized_rows [11]
- 0.00 0.00 1/13 get_nrows [73]
- 0.00 0.00 1/13 get_ncols [72]
------------------------------------------------
- 0.00 0.12 1/1 kjg_fpca [12]
-[28] 0.7 0.00 0.12 1 kjg_fpca_XTB [28]
- 0.00 0.12 40/480 kjg_geno_get_normalized_rows [11]
- 0.00 0.00 1/13 get_nrows [73]
- 0.00 0.00 1/13 get_ncols [72]
------------------------------------------------
- 0.11 0.00 40000000/40000000 ineigenstrat [9]
-[29] 0.7 0.11 0.00 40000000 checkxval [29]
------------------------------------------------
- 0.00 0.00 1/34005 iseigenstrat [50]
- 0.00 0.00 1/34005 getint [49]
- 0.00 0.00 3/34005 getstring [48]
- 0.00 0.01 2000/34005 readinddata [45]
- 0.00 0.03 10000/34005 readsnpdata [36]
- 0.00 0.03 10000/34005 ineigenstrat [9]
- 0.00 0.04 12000/34005 getsizex [35]
-[30] 0.7 0.00 0.11 34005 splitup [30]
- 0.11 0.00 34005/34005 splitupwxbuff [31]
------------------------------------------------
- 0.11 0.00 34005/34005 splitup [30]
-[31] 0.7 0.11 0.00 34005 splitupwxbuff [31]
------------------------------------------------
- 0.00 0.00 10/10020 writesnpeigs [40]
- 0.00 0.00 10/10020 setfvecs [46]
- 0.11 0.00 10000/10020 getcolxz [14]
-[32] 0.7 0.11 0.00 10020 vst [32]
------------------------------------------------
- 0.00 0.08 1/1 main [4]
-[33] 0.5 0.00 0.08 1 getsnps [33]
- 0.00 0.03 1/1 readsnpdata [36]
- 0.00 0.02 10000/10000 clearsnp [39]
- 0.00 0.02 1/2 getsizex [35]
- 0.01 0.00 10000/30001 cclear [37]
- 0.00 0.00 20000/30101 nnint [55]
- 0.00 0.00 1/10002 ivclear [62]
- 0.00 0.00 1/1 dobadsnps [95]
- 0.00 0.00 1/1 ipsortit [99]
- 0.00 0.00 1/1 numfakes [109]
- 0.00 0.00 1/1 loadsnps [107]
- 0.00 0.00 1/10001 isnumword [64]
------------------------------------------------
- <spontaneous>
-[34] 0.3 0.04 0.00 LAPACKE_dge_trans [34]
------------------------------------------------
- 0.00 0.02 1/2 getsnps [33]
- 0.00 0.02 1/2 getindivs [38]
-[35] 0.2 0.00 0.04 2 getsizex [35]
- 0.00 0.04 12000/34005 splitup [30]
- 0.00 0.00 12000/24000 setskipit [56]
- 0.00 0.00 12000/34005 freeup [54]
- 0.00 0.00 2/6 openit [81]
------------------------------------------------
- 0.00 0.03 1/1 getsnps [33]
-[36] 0.2 0.00 0.03 1 readsnpdata [36]
- 0.00 0.03 10000/34005 splitup [30]
- 0.00 0.00 10000/24000 setskipit [56]
- 0.00 0.00 10000/10000 str2chrom [67]
- 0.00 0.00 10000/10000 setsdpos [66]
- 0.00 0.00 10000/10001 ivzero [65]
- 0.00 0.00 10000/34005 freeup [54]
- 0.00 0.00 1/1 ismapfile [102]
- 0.00 0.00 1/2003 vclear [68]
- 0.00 0.00 1/6 openit [81]
------------------------------------------------
- 0.00 0.00 1/30001 clearepath [51]
- 0.01 0.00 10000/30001 getsnps [33]
- 0.02 0.00 20000/30001 clearsnp [39]
-[37] 0.2 0.03 0.00 30001 cclear [37]
------------------------------------------------
- 0.00 0.03 1/1 main [4]
-[38] 0.2 0.00 0.03 1 getindivs [38]
- 0.00 0.02 1/2 getsizex [35]
- 0.00 0.01 1/1 readinddata [45]
- 0.00 0.00 1/1 clearind [92]
------------------------------------------------
- 0.00 0.02 10000/10000 getsnps [33]
-[39] 0.1 0.00 0.02 10000 clearsnp [39]
- 0.02 0.00 20000/30001 cclear [37]
------------------------------------------------
- <spontaneous>
-[40] 0.1 0.00 0.01 writesnpeigs [40]
- 0.01 0.00 100/100 vlmaxmin [41]
- 0.00 0.00 10/10020 vst [32]
- 0.00 0.00 100/30101 nnint [55]
- 0.00 0.00 10/10 asum2 [76]
- 0.00 0.00 1/2003 vclear [68]
------------------------------------------------
- 0.01 0.00 100/100 writesnpeigs [40]
-[41] 0.1 0.01 0.00 100 vlmaxmin [41]
------------------------------------------------
- 0.01 0.00 1/1 getgenos [8]
-[42] 0.1 0.01 0.00 1 freeped [42]
------------------------------------------------
- <spontaneous>
-[43] 0.1 0.01 0.00 LAPACKE_dge_nancheck [43]
------------------------------------------------
- <spontaneous>
-[44] 0.1 0.01 0.00 hashit [44]
------------------------------------------------
- 0.00 0.01 1/1 getindivs [38]
-[45] 0.0 0.00 0.01 1 readinddata [45]
- 0.00 0.01 2000/34005 splitup [30]
- 0.00 0.00 2000/24000 setskipit [56]
- 0.00 0.00 2000/34005 freeup [54]
- 0.00 0.00 1/2 ispedfile [88]
- 0.00 0.00 1/6 openit [81]
------------------------------------------------
- 0.00 0.00 1/1 printevecs [1]
-[46] 0.0 0.00 0.00 1 setfvecs [46]
- 0.00 0.00 10/10020 vst [32]
- 0.00 0.00 10/11 copyarr [74]
------------------------------------------------
- <spontaneous>
-[47] 0.0 0.00 0.00 readcommands [47]
- 0.00 0.00 31/31 getstring [48]
- 0.00 0.00 55/55 getint [49]
- 0.00 0.00 11/11 getdbl [75]
- 0.00 0.00 1/1 pcheck [111]
- 0.00 0.00 1/1 openpars [110]
- 0.00 0.00 1/1 dostrsub [96]
- 0.00 0.00 1/1 writepars [121]
------------------------------------------------
- 0.00 0.00 31/31 readcommands [47]
-[48] 0.0 0.00 0.00 31 getstring [48]
- 0.00 0.00 3/34005 splitup [30]
- 0.00 0.00 31/97 findpname [71]
- 0.00 0.00 3/34005 freeup [54]
------------------------------------------------
- 0.00 0.00 55/55 readcommands [47]
-[49] 0.0 0.00 0.00 55 getint [49]
- 0.00 0.00 1/34005 splitup [30]
- 0.00 0.00 55/97 findpname [71]
- 0.00 0.00 1/34005 freeup [54]
------------------------------------------------
- 0.00 0.00 1/1 getgenos [8]
-[50] 0.0 0.00 0.00 1 iseigenstrat [50]
- 0.00 0.00 1/34005 splitup [30]
- 0.00 0.00 1/6 openit [81]
- 0.00 0.00 1/34005 freeup [54]
------------------------------------------------
- 0.00 0.00 1/1 ineigenstrat [9]
-[51] 0.0 0.00 0.00 1 clearepath [51]
- 0.00 0.00 1/30001 cclear [37]
------------------------------------------------
- 0.00 0.00 1/142006 ineigenstrat [9]
- 0.00 0.00 142005/142006 freeup [54]
-[52] 0.0 0.00 0.00 142006 freestring [52]
------------------------------------------------
- 0.00 0.00 64608/64608 ipcompit [400]
-[53] 0.0 0.00 0.00 64608 compiarr [53]
------------------------------------------------
- 0.00 0.00 1/34005 iseigenstrat [50]
- 0.00 0.00 1/34005 getint [49]
- 0.00 0.00 3/34005 getstring [48]
- 0.00 0.00 2000/34005 readinddata [45]
- 0.00 0.00 10000/34005 readsnpdata [36]
- 0.00 0.00 10000/34005 ineigenstrat [9]
- 0.00 0.00 12000/34005 getsizex [35]
-[54] 0.0 0.00 0.00 34005 freeup [54]
- 0.00 0.00 142005/142006 freestring [52]
------------------------------------------------
- 0.00 0.00 1/30101 ineigenstrat [9]
- 0.00 0.00 100/30101 writesnpeigs [40]
- 0.00 0.00 10000/30101 main [4]
- 0.00 0.00 20000/30101 getsnps [33]
-[55] 0.0 0.00 0.00 30101 nnint [55]
------------------------------------------------
- 0.00 0.00 2000/24000 readinddata [45]
- 0.00 0.00 10000/24000 readsnpdata [36]
- 0.00 0.00 12000/24000 getsizex [35]
-[56] 0.0 0.00 0.00 24000 setskipit [56]
------------------------------------------------
- 0.00 0.00 1/20001 ipsortitp [100]
- 0.00 0.00 20000/20001 loadsnps [107]
-[57] 0.0 0.00 0.00 20001 copyiarr [57]
------------------------------------------------
- 0.00 0.00 20000/20000 mknn [60]
-[58] 0.0 0.00 0.00 20000 intsum [58]
------------------------------------------------
- 0.00 0.00 20000/20000 kjg_gsl_ran_ugaussian_matrix [104]
-[59] 0.0 0.00 0.00 20000 kjg_gsl_ran_ugaussian_pair [59]
------------------------------------------------
- 0.00 0.00 20000/20000 loadsnps [107]
-[60] 0.0 0.00 0.00 20000 mknn [60]
- 0.00 0.00 20000/20000 intsum [58]
------------------------------------------------
- 0.00 0.00 10000/20000 setsdpos [66]
- 0.00 0.00 10000/20000 str2chrom [67]
-[61] 0.0 0.00 0.00 20000 mkupper [61]
------------------------------------------------
- 0.00 0.00 1/10002 getsnps [33]
- 0.00 0.00 10001/10002 ivzero [65]
-[62] 0.0 0.00 0.00 10002 ivclear [62]
------------------------------------------------
- 0.00 0.00 10001/10001 isnumword [64]
-[63] 0.0 0.00 0.00 10001 NPisnumber [63]
------------------------------------------------
- 0.00 0.00 1/10001 getsnps [33]
- 0.00 0.00 10000/10001 str2chrom [67]
-[64] 0.0 0.00 0.00 10001 isnumword [64]
- 0.00 0.00 10001/10001 NPisnumber [63]
------------------------------------------------
- 0.00 0.00 1/10001 numvalidgtallind [20]
- 0.00 0.00 10000/10001 readsnpdata [36]
-[65] 0.0 0.00 0.00 10001 ivzero [65]
- 0.00 0.00 10001/10002 ivclear [62]
------------------------------------------------
- 0.00 0.00 10000/10000 readsnpdata [36]
-[66] 0.0 0.00 0.00 10000 setsdpos [66]
- 0.00 0.00 10000/20000 mkupper [61]
------------------------------------------------
- 0.00 0.00 10000/10000 readsnpdata [36]
-[67] 0.0 0.00 0.00 10000 str2chrom [67]
- 0.00 0.00 10000/20000 mkupper [61]
- 0.00 0.00 10000/10001 isnumword [64]
------------------------------------------------
- 0.00 0.00 1/2003 writesnpeigs [40]
- 0.00 0.00 1/2003 readsnpdata [36]
- 0.00 0.00 1/2003 setgval [24]
- 0.00 0.00 2000/2003 vzero [70]
-[68] 0.0 0.00 0.00 2003 vclear [68]
------------------------------------------------
- 0.00 0.00 2000/2000 makeeglist [108]
-[69] 0.0 0.00 0.00 2000 indxindex [69]
------------------------------------------------
- 0.00 0.00 2000/2000 cleartg [93]
-[70] 0.0 0.00 0.00 2000 vzero [70]
- 0.00 0.00 2000/2003 vclear [68]
------------------------------------------------
- 0.00 0.00 11/97 getdbl [75]
- 0.00 0.00 31/97 getstring [48]
- 0.00 0.00 55/97 getint [49]
-[71] 0.0 0.00 0.00 97 findpname [71]
------------------------------------------------
- 0.00 0.00 1/13 kjg_fpca [12]
- 0.00 0.00 1/13 kjg_fpca_XA [27]
- 0.00 0.00 1/13 kjg_fpca_XTB [28]
- 0.00 0.00 10/13 kjg_fpca_XTXA [13]
-[72] 0.0 0.00 0.00 13 get_ncols [72]
------------------------------------------------
- 0.00 0.00 1/13 kjg_fpca [12]
- 0.00 0.00 1/13 kjg_fpca_XA [27]
- 0.00 0.00 1/13 kjg_fpca_XTB [28]
- 0.00 0.00 10/13 kjg_fpca_XTXA [13]
-[73] 0.0 0.00 0.00 13 get_nrows [73]
------------------------------------------------
- 0.00 0.00 1/11 transpose [118]
- 0.00 0.00 10/11 setfvecs [46]
-[74] 0.0 0.00 0.00 11 copyarr [74]
------------------------------------------------
- 0.00 0.00 11/11 readcommands [47]
-[75] 0.0 0.00 0.00 11 getdbl [75]
- 0.00 0.00 11/97 findpname [71]
------------------------------------------------
- 0.00 0.00 10/10 writesnpeigs [40]
-[76] 0.0 0.00 0.00 10 asum2 [76]
------------------------------------------------
- 0.00 0.00 10/10 kjg_gsl_matrix_QR [79]
-[77] 0.0 0.00 0.00 10 kjg_gsl_dgeqrf [77]
------------------------------------------------
- 0.00 0.00 10/10 kjg_gsl_matrix_QR [79]
-[78] 0.0 0.00 0.00 10 kjg_gsl_dorgqr [78]
------------------------------------------------
- 0.00 0.00 10/10 kjg_fpca [12]
-[79] 0.0 0.00 0.00 10 kjg_gsl_matrix_QR [79]
- 0.00 0.00 10/10 kjg_gsl_dgeqrf [77]
- 0.00 0.00 10/10 kjg_gsl_dorgqr [78]
------------------------------------------------
- 0.00 0.00 8/8 first_word [82]
-[80] 0.0 0.00 0.00 8 fnwhite [80]
------------------------------------------------
- 0.00 0.00 1/6 readsnpdata [36]
- 0.00 0.00 1/6 readinddata [45]
- 0.00 0.00 1/6 iseigenstrat [50]
- 0.00 0.00 1/6 ineigenstrat [9]
- 0.00 0.00 2/6 getsizex [35]
-[81] 0.0 0.00 0.00 6 openit [81]
------------------------------------------------
- 0.00 0.00 4/4 openpars [110]
-[82] 0.0 0.00 0.00 4 first_word [82]
- 0.00 0.00 8/8 fnwhite [80]
- 0.00 0.00 4/4 fwhite [83]
------------------------------------------------
- 0.00 0.00 4/4 first_word [82]
-[83] 0.0 0.00 0.00 4 fwhite [83]
------------------------------------------------
- 0.00 0.00 4/4 openpars [110]
-[84] 0.0 0.00 0.00 4 indxstring [84]
------------------------------------------------
- 0.00 0.00 4/4 openpars [110]
-[85] 0.0 0.00 0.00 4 stripcomment [85]
------------------------------------------------
- 0.00 0.00 4/4 openpars [110]
-[86] 0.0 0.00 0.00 4 striptrail [86]
------------------------------------------------
- 0.00 0.00 4/4 dostrsub [96]
-[87] 0.0 0.00 0.00 4 upstring [87]
------------------------------------------------
- 0.00 0.00 1/2 readinddata [45]
- 0.00 0.00 1/2 getgenos [8]
-[88] 0.0 0.00 0.00 2 ispedfile [88]
------------------------------------------------
- 0.00 0.00 2/2 kjg_fpca [12]
-[89] 0.0 0.00 0.00 2 kjg_gsl_SVD [89]
------------------------------------------------
- 0.00 0.00 1/2 numfakes [109]
- 0.00 0.00 1/2 loadsnps [107]
-[90] 0.0 0.00 0.00 2 nextmesh [90]
------------------------------------------------
- 0.00 0.00 1/1 getgenos [8]
-[91] 0.0 0.00 0.00 1 checksize [91]
------------------------------------------------
- 0.00 0.00 1/1 getindivs [38]
-[92] 0.0 0.00 0.00 1 clearind [92]
- 0.00 0.00 1/1 cleartg [93]
------------------------------------------------
- 0.00 0.00 1/1 clearind [92]
-[93] 0.0 0.00 0.00 1 cleartg [93]
- 0.00 0.00 2000/2000 vzero [70]
------------------------------------------------
- 0.00 0.00 1/1 ipsortitp [100]
-[94] 0.0 0.00 0.00 1 copyiparr [94]
------------------------------------------------
- 0.00 0.00 1/1 getsnps [33]
-[95] 0.0 0.00 0.00 1 dobadsnps [95]
------------------------------------------------
- 0.00 0.00 1/1 readcommands [47]
-[96] 0.0 0.00 0.00 1 dostrsub [96]
- 0.00 0.00 4/4 upstring [87]
------------------------------------------------
- 0.00 0.00 1/1 rmsnps [112]
-[97] 0.0 0.00 0.00 1 freesnpindex [97]
------------------------------------------------
- 0.00 0.00 1/1 setgval [24]
-[98] 0.0 0.00 0.00 1 initarray_2Ddouble [98]
------------------------------------------------
- 0.00 0.00 1/1 getsnps [33]
-[99] 0.0 0.00 0.00 1 ipsortit [99]
- 0.00 0.00 1/1 ipsortitp [100]
------------------------------------------------
- 0.00 0.00 1/1 ipsortit [99]
-[100] 0.0 0.00 0.00 1 ipsortitp [100]
- 0.00 0.00 1/1 setorder [115]
- 0.00 0.00 1/1 copyiparr [94]
- 0.00 0.00 1/20001 copyiarr [57]
------------------------------------------------
- 0.00 0.00 1/1 getgenos [8]
-[101] 0.0 0.00 0.00 1 isbedfile [101]
------------------------------------------------
- 0.00 0.00 1/1 readsnpdata [36]
-[102] 0.0 0.00 0.00 1 ismapfile [102]
------------------------------------------------
- 0.00 0.00 1/1 getgenos [8]
-[103] 0.0 0.00 0.00 1 ispack [103]
------------------------------------------------
- 0.00 0.00 1/1 kjg_fpca [12]
-[104] 0.0 0.00 0.00 1 kjg_gsl_ran_ugaussian_matrix [104]
- 0.00 0.00 20000/20000 kjg_gsl_ran_ugaussian_pair [59]
------------------------------------------------
- 0.00 0.00 1/1 kjg_fpca [12]
-[105] 0.0 0.00 0.00 1 kjg_gsl_rng_init [105]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[106] 0.0 0.00 0.00 1 loadindx [106]
------------------------------------------------
- 0.00 0.00 1/1 getsnps [33]
-[107] 0.0 0.00 0.00 1 loadsnps [107]
- 0.00 0.00 20000/20000 mknn [60]
- 0.00 0.00 20000/20001 copyiarr [57]
- 0.00 0.00 1/2 nextmesh [90]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[108] 0.0 0.00 0.00 1 makeeglist [108]
- 0.00 0.00 2000/2000 indxindex [69]
------------------------------------------------
- 0.00 0.00 1/1 getsnps [33]
-[109] 0.0 0.00 0.00 1 numfakes [109]
- 0.00 0.00 1/2 nextmesh [90]
------------------------------------------------
- 0.00 0.00 1/1 readcommands [47]
-[110] 0.0 0.00 0.00 1 openpars [110]
- 0.00 0.00 4/4 first_word [82]
- 0.00 0.00 4/4 indxstring [84]
- 0.00 0.00 4/4 striptrail [86]
- 0.00 0.00 4/4 stripcomment [85]
------------------------------------------------
- 0.00 0.00 1/1 readcommands [47]
-[111] 0.0 0.00 0.00 1 pcheck [111]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[112] 0.0 0.00 0.00 1 rmsnps [112]
- 0.00 0.00 1/1 freesnpindex [97]
------------------------------------------------
- 0.00 0.00 1/1 setgval [24]
-[113] 0.0 0.00 0.00 1 set_ind_mask [113]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[114] 0.0 0.00 0.00 1 setomode [114]
------------------------------------------------
- 0.00 0.00 1/1 ipsortitp [100]
-[115] 0.0 0.00 0.00 1 setorder [115]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[116] 0.0 0.00 0.00 1 setstatus [116]
- 0.00 0.00 1/1 setstatusv [117]
------------------------------------------------
- 0.00 0.00 1/1 setstatus [116]
-[117] 0.0 0.00 0.00 1 setstatusv [117]
------------------------------------------------
- 0.00 0.00 1/1 main [4]
-[118] 0.0 0.00 0.00 1 transpose [118]
- 0.00 0.00 1/11 copyarr [74]
------------------------------------------------
- 0.00 0.00 1/1 printevecs [1]
-[119] 0.0 0.00 0.00 1 vinvert [119]
------------------------------------------------
- 0.00 0.00 1/1 printevecs [1]
-[120] 0.0 0.00 0.00 1 vsqrt [120]
------------------------------------------------
- 0.00 0.00 1/1 readcommands [47]
-[121] 0.0 0.00 0.00 1 writepars [121]
------------------------------------------------
-
- This table describes the call tree of the program, and was sorted by
- the total amount of time spent in each function and its children.
-
- Each entry in this table consists of several lines. The line with the
- index number at the left hand margin lists the current function.
- The lines above it list the functions that called this function,
- and the lines below it list the functions this one called.
- This line lists:
- index A unique number given to each element of the table.
- Index numbers are sorted numerically.
- The index number is printed next to every function name so
- it is easier to look up where the function in the table.
-
- % time This is the percentage of the `total' time that was spent
- in this function and its children. Note that due to
- different viewpoints, functions excluded by options, etc,
- these numbers will NOT add up to 100%.
-
- self This is the total amount of time spent in this function.
-
- children This is the total amount of time propagated into this
- function by its children.
-
- called This is the number of times the function was called.
- If the function called itself recursively, the number
- only includes non-recursive calls, and is followed by
- a `+' and the number of recursive calls.
-
- name The name of the current function. The index number is
- printed after it. If the function is a member of a
- cycle, the cycle number is printed between the
- function's name and the index number.
-
-
- For the function's parents, the fields have the following meanings:
-
- self This is the amount of time that was propagated directly
- from the function into this parent.
-
- children This is the amount of time that was propagated from
- the function's children into this parent.
-
- called This is the number of times this parent called the
- function `/' the total number of times the function
- was called. Recursive calls to the function are not
- included in the number after the `/'.
-
- name This is the name of the parent. The parent's index
- number is printed after it. If the parent is a
- member of a cycle, the cycle number is printed between
- the name and the index number.
-
- If the parents of the function cannot be determined, the word
- `<spontaneous>' is printed in the `name' field, and all the other
- fields are blank.
-
- For the function's children, the fields have the following meanings:
-
- self This is the amount of time that was propagated directly
- from the child into the function.
-
- children This is the amount of time that was propagated from the
- child's children to the function.
-
- called This is the number of times the function called
- this child `/' the total number of times the child
- was called. Recursive calls by the child are not
- listed in the number after the `/'.
-
- name This is the name of the child. The child's index
- number is printed after it. If the child is a
- member of a cycle, the cycle number is printed
- between the name and the index number.
-
- If there are any cycles (circles) in the call graph, there is an
- entry for the cycle-as-a-whole. This entry shows who called the
- cycle (as parents) and the members of the cycle (as children.)
- The `+' recursive calls entry shows the number of function calls that
- were internal to the cycle, and the calls entry for each member shows,
- for that member, how many times it was called from other members of
- the cycle.
-
-
-Index by function name
-
- [43] LAPACKE_dge_nancheck [33] getsnps [17] numvalidgt
- [34] LAPACKE_dge_trans [48] getstring [20] numvalidgtallind
- [63] NPisnumber [44] hashit [19] numvalidgtx
- [76] asum2 [69] indxindex [81] openit
- [37] cclear [84] indxstring [110] openpars
- [91] checksize [9] ineigenstrat [111] pcheck
- [29] checkxval [98] initarray_2Ddouble [1] printevecs
- [51] clearepath [58] intsum [15] putgtypes
- [92] clearind [99] ipsortit [6] rbuff
- [39] clearsnp [100] ipsortitp [45] readinddata
- [93] cleartg [101] isbedfile [36] readsnpdata
- [53] compiarr [50] iseigenstrat [112] rmsnps
- [74] copyarr [102] ismapfile [113] set_ind_mask
- [57] copyiarr [64] isnumword [46] setfvecs
- [94] copyiparr [103] ispack [24] setgval
- [95] dobadsnps [88] ispedfile [114] setomode
- [96] dostrsub [62] ivclear [115] setorder
- [71] findpname [65] ivzero [66] setsdpos
- [82] first_word [12] kjg_fpca [56] setskipit
- [26] floatit [27] kjg_fpca_XA [116] setstatus
- [80] fnwhite [28] kjg_fpca_XTB [117] setstatusv
- [42] freeped [13] kjg_fpca_XTXA [30] splitup
- [97] freesnpindex [10] kjg_geno_get_normalized_row [31] splitupwxbuff
- [52] freestring [11] kjg_geno_get_normalized_rows [67] str2chrom
- [54] freeup [89] kjg_gsl_SVD [85] stripcomment
- [22] fvadjust [77] kjg_gsl_dgeqrf [86] striptrail
- [83] fwhite [78] kjg_gsl_dorgqr [118] transpose
- [72] get_ncols [79] kjg_gsl_matrix_QR [25] unsetgval
- [73] get_nrows [104] kjg_gsl_ran_ugaussian_matrix [87] upstring
- [14] getcolxz [59] kjg_gsl_ran_ugaussian_pair [68] vclear
- [75] getdbl [105] kjg_gsl_rng_init [7] vdot
- [23] getgall [106] loadindx [119] vinvert
- [8] getgenos [107] loadsnps [41] vlmaxmin
- [3] getggval [18] loadsnpx [120] vsqrt
- [5] getgtypes [108] makeeglist [32] vst
- [2] getgval [60] mknn [70] vzero
- [38] getindivs [61] mkupper [16] wbuff
- [49] getint [90] nextmesh [121] writepars
- [21] getrawcol [55] nnint
- [35] getsizex [109] numfakes
diff --git a/src/smarttables/twtable b/src/smarttables/twtable
deleted file mode 100644
index 2042c62..0000000
--- a/src/smarttables/twtable
+++ /dev/null
@@ -1,164 +0,0 @@
-### this is a table of TW using a Runge-Kutta solver suggested by Per-Olaf Persson
-### algorithm coded in C by NP using NAG ODE solver
-### arg r tail pdf
- -8.000 1.000000000 0.000000000
- -7.900 1.000000000 0.000000000
- -7.800 1.000000000 0.000000000
- -7.700 1.000000000 0.000000000
- -7.600 1.000000000 0.000000000
- -7.500 1.000000000 0.000000001
- -7.400 1.000000000 0.000000002
- -7.300 0.999999999 0.000000005
- -7.200 0.999999999 0.000000010
- -7.100 0.999999997 0.000000019
- -7.000 0.999999995 0.000000039
- -6.900 0.999999989 0.000000076
- -6.800 0.999999978 0.000000146
- -6.700 0.999999958 0.000000276
- -6.600 0.999999920 0.000000511
- -6.500 0.999999849 0.000000932
- -6.400 0.999999723 0.000001670
- -6.300 0.999999498 0.000002942
- -6.200 0.999999105 0.000005097
- -6.100 0.999998431 0.000008683
- -6.000 0.999997293 0.000014554
- -5.900 0.999995401 0.000024005
- -5.800 0.999992309 0.000038969
- -5.700 0.999987331 0.000062279
- -5.600 0.999979441 0.000098012
- -5.500 0.999967125 0.000151923
- -5.400 0.999948187 0.000231995
- -5.300 0.999919496 0.000349097
- -5.200 0.999876655 0.000517756
- -5.100 0.999813597 0.000757035
- -5.000 0.999722082 0.001091485
- -4.900 0.999591101 0.001552137
- -4.800 0.999406175 0.002177466
- -4.700 0.999148569 0.003014256
- -4.600 0.998794427 0.004118267
- -4.500 0.998313849 0.005554591
- -4.400 0.997669962 0.007397591
- -4.300 0.996818016 0.009730295
- -4.200 0.995704571 0.012643159
- -4.100 0.994266851 0.016232112
- -4.000 0.992432322 0.020595851
- -3.900 0.990118582 0.025832397
- -3.800 0.987233631 0.032034971
- -3.700 0.983676579 0.039287325
- -3.600 0.979338843 0.047658716
- -3.500 0.974105853 0.057198759
- -3.400 0.967859270 0.067932445
- -3.300 0.960479677 0.079855636
- -3.200 0.951849687 0.092931337
- -3.100 0.941857369 0.107087044
- -3.000 0.930399881 0.122213418
- -2.900 0.917387157 0.138164458
- -2.800 0.902745495 0.154759279
- -2.700 0.886420892 0.171785501
- -2.600 0.868381957 0.189004169
- -2.500 0.848622271 0.206156009
- -2.400 0.827162053 0.222968755
- -2.300 0.804049066 0.239165233
- -2.200 0.779358684 0.254471803
- -2.100 0.753193114 0.268626779
- -2.000 0.725679802 0.281388431
- -1.900 0.696969061 0.292542221
- -1.800 0.667231036 0.301906945
- -1.700 0.636652122 0.309339558
- -1.600 0.605430961 0.314738516
- -1.500 0.573774198 0.318045543
- -1.400 0.541892124 0.319245849
- -1.300 0.509994383 0.318366852
- -1.200 0.478285870 0.315475570
- -1.100 0.446962951 0.310674866
- -1.000 0.416210105 0.304098784
- -0.900 0.386197065 0.295907232
- -0.800 0.357076521 0.286280263
- -0.700 0.328982392 0.275412215
- -0.600 0.302028689 0.263505933
- -0.500 0.276308949 0.250767272
- -0.400 0.251896179 0.237400053
- -0.300 0.228843301 0.223601597
- -0.200 0.207183986 0.209558915
- -0.100 0.186933854 0.195445624
- 0.000 0.168091934 0.181419571
- 0.100 0.150642330 0.167621190
- 0.200 0.134556018 0.154172511
- 0.300 0.119792709 0.141176787
- 0.400 0.106302721 0.128718659
- 0.500 0.094028817 0.116864772
- 0.600 0.082907953 0.105664756
- 0.700 0.072872924 0.095152500
- 0.800 0.063853860 0.085347620
- 0.900 0.055779577 0.076257058
- 1.000 0.048578763 0.067876743
- 1.100 0.042180992 0.060193257
- 1.200 0.036517582 0.053185457
- 1.300 0.031522284 0.046826015
- 1.400 0.027131832 0.041082856
- 1.500 0.023286351 0.035920459
- 1.600 0.019929640 0.031301023
- 1.700 0.017009350 0.027185487
- 1.800 0.014477062 0.023534398
- 1.900 0.012288293 0.020308645
- 2.000 0.010402429 0.017470054
- 2.100 0.008782605 0.014981856
- 2.200 0.007395547 0.012809046
- 2.300 0.006211384 0.010918644
- 2.400 0.005203434 0.009279861
- 2.500 0.004347977 0.007864200
- 2.600 0.003624031 0.006645482
- 2.700 0.003013114 0.005599836
- 2.800 0.002499018 0.004705636
- 2.900 0.002067590 0.003943413
- 3.000 0.001706520 0.003295741
- 3.100 0.001405143 0.002747112
- 3.200 0.001154255 0.002283795
- 3.300 0.000945945 0.001893694
- 3.400 0.000773431 0.001566204
- 3.500 0.000630927 0.001292071
- 3.600 0.000513508 0.001063253
- 3.700 0.000416999 0.000872795
- 3.800 0.000337871 0.000714702
- 3.900 0.000273152 0.000583831
- 4.000 0.000220344 0.000475784
- 4.100 0.000177359 0.000386816
- 4.200 0.000142452 0.000313749
- 4.300 0.000114170 0.000253894
- 4.400 0.000091308 0.000204987
- 4.500 0.000072871 0.000165125
- 4.600 0.000058035 0.000132716
- 4.700 0.000046124 0.000106431
- 4.800 0.000036582 0.000085163
- 4.900 0.000028955 0.000067996
- 5.000 0.000022872 0.000054172
- 5.100 0.000018030 0.000043066
- 5.200 0.000014185 0.000034164
- 5.300 0.000011138 0.000027045
- 5.400 0.000008728 0.000021365
- 5.500 0.000006826 0.000016843
- 5.600 0.000005328 0.000013250
- 5.700 0.000004151 0.000010403
- 5.800 0.000003228 0.000008151
- 5.900 0.000002505 0.000006374
- 6.000 0.000001941 0.000004974
- 6.100 0.000001501 0.000003874
- 6.200 0.000001158 0.000003011
- 6.300 0.000000892 0.000002336
- 6.400 0.000000686 0.000001809
- 6.500 0.000000527 0.000001398
- 6.600 0.000000403 0.000001078
- 6.700 0.000000308 0.000000830
- 6.800 0.000000235 0.000000638
- 6.900 0.000000179 0.000000489
- 7.000 0.000000136 0.000000375
- 7.100 0.000000104 0.000000286
- 7.200 0.000000079 0.000000218
- 7.300 0.000000059 0.000000166
- 7.400 0.000000045 0.000000126
- 7.500 0.000000034 0.000000096
- 7.600 0.000000025 0.000000073
- 7.700 0.000000019 0.000000055
- 7.800 0.000000014 0.000000041
- 7.900 0.000000011 0.000000031
- 8.000 0.000000008 0.000000023
diff --git a/src/twsubs.c b/src/twsubs.c
index fdfd1dc..356d9b9 100644
--- a/src/twsubs.c
+++ b/src/twsubs.c
@@ -8,228 +8,247 @@
/* ********************************************************************* */
-extern int verbose ;
+extern int verbose;
-int twl2mode = YES ;
-int mval = -1 ;
-int nval = -1 ;
+int twl2mode = YES;
+int mval = -1;
+int nval = -1;
int numsamp = 100;
-double mul1 = 1.0 ;
-
-
-double xxlike(int m, double a, double var, double logsum, double lsum) ;
-double xxlikex(int m, double a, double logsum, double lsum) ;
-double xxliked(int m, double a, double logsum, double lsum) ;
-double xxliked2(int m, double a, double logsum, double lsum) ;
-double oldtwestxx(double *lam, int m, double *pzn, double *pzvar) ;
-double doeig2(double *vals, int m, double *pzn, double *ptw) ;
-
-double twestxx(double *lam, int m, double *pzn, double *pzvar)
+double mul1 = 1.0;
+
+double
+xxlike (int m, double a, double var, double logsum, double lsum);
+double
+xxlikex (int m, double a, double logsum, double lsum);
+double
+xxliked (int m, double a, double logsum, double lsum);
+double
+xxliked2 (int m, double a, double logsum, double lsum);
+double
+oldtwestxx (double *lam, int m, double *pzn, double *pzvar);
+double
+doeig2 (double *vals, int m, double *pzn, double *ptw);
+
+double
+twestxx (double *lam, int m, double *pzn, double *pzvar)
{
- double tw, y ;
+ double tw, y;
- if (twl2mode == NO) return oldtwestxx(lam, m, pzn, pzvar) ;
- (void) doeig2(lam, m, pzn, &tw) ;
+ if (twl2mode == NO)
+ return oldtwestxx (lam, m, pzn, pzvar);
+ (void) doeig2 (lam, m, pzn, &tw);
- y = (*pzn) * (double) m ;
- *pzvar = asum(lam, m) / y ;
- return tw ;
+ y = (*pzn) * (double) m;
+ *pzvar = asum (lam, m) / y;
+ return tw;
}
-double oldtwestxx(double *lam, int m, double *pzn, double *pzvar)
+double
+oldtwestxx (double *lam, int m, double *pzn, double *pzvar)
{
- double lsum, logsum ;
- double *ww ;
- double a, p, yn, var ;
- double ylike, ybase, y, ylmax, ynmax, yld, yld2, ainc, ym ;
- int k ;
-
-
- ZALLOC(ww, m, double) ;
- copyarr(lam, ww, m) ;
- lsum = asum(ww, m) ;
- vlog(ww, ww, m) ;
- logsum = asum(ww, m) ;
-
- ylmax = -1.0e20 ;
- yn = (double) m ;
- ybase = xxlikex(m, yn, logsum, lsum) ;
-
- for (k= 1; k<=100; ++k) {
- a = yn/2.0 ;
- ylike = xxlikex(m, a, logsum, lsum) ;
- yld = xxliked(m, a, logsum, lsum) ;
- ylike -= ybase ;
- if (verbose)
- printf("ynloop %12.3f %12.3f %12.3f\n", yn / (double) m , ylike, yld) ;
- if (ylike < ylmax) break ;
- ylmax = ylike ;
- ynmax = yn ;
- yn *= 1.1 ;
- }
- a = ynmax/2.0 ;
- for (k= 1; k<=10; ++k) {
+ double lsum, logsum;
+ double *ww;
+ double a, p, yn, var;
+ double ylike, ybase, y, ylmax, ynmax, yld, yld2, ainc, ym;
+ int k;
+
+ ZALLOC(ww, m, double);
+ copyarr (lam, ww, m);
+ lsum = asum (ww, m);
+ vlog (ww, ww, m);
+ logsum = asum (ww, m);
+
+ ylmax = -1.0e20;
+ yn = (double) m;
+ ybase = xxlikex (m, yn, logsum, lsum);
+
+ for (k = 1; k <= 100; ++k)
+ {
+ a = yn / 2.0;
+ ylike = xxlikex (m, a, logsum, lsum);
+ yld = xxliked (m, a, logsum, lsum);
+ ylike -= ybase;
+ if (verbose)
+ printf ("ynloop %12.3f %12.3f %12.3f\n", yn / (double) m, ylike, yld);
+ if (ylike < ylmax)
+ break;
+ ylmax = ylike;
+ ynmax = yn;
+ yn *= 1.1;
+ }
+ a = ynmax / 2.0;
+ for (k = 1; k <= 10; ++k)
+ {
// newton iteration
- ylike = xxlikex(m, a, logsum, lsum) ;
- yld = xxliked(m, a, logsum, lsum) ;
- yld2 = xxliked2(m, a, logsum, lsum) ;
- ylike -= ybase ;
- ainc = -yld/yld2 ;
- a += ainc ;
- if (verbose)
- printf("newton: %3d %15.9f %15.9f %15.9f\n", k, ylike, yld, ainc) ;
- }
- fflush(stdout) ;
- yn = 2.0*a ;
- ym = (double) m ;
- var = lsum/ (2.0*a*ym) ;
-
- *pzn = yn ;
- *pzvar = var ;
-
- free(ww) ;
- return 0 ;
+ ylike = xxlikex (m, a, logsum, lsum);
+ yld = xxliked (m, a, logsum, lsum);
+ yld2 = xxliked2 (m, a, logsum, lsum);
+ ylike -= ybase;
+ ainc = -yld / yld2;
+ a += ainc;
+ if (verbose)
+ printf ("newton: %3d %15.9f %15.9f %15.9f\n", k, ylike, yld, ainc);
+ }
+ fflush (stdout);
+ yn = 2.0 * a;
+ ym = (double) m;
+ var = lsum / (2.0 * a * ym);
+
+ *pzn = yn;
+ *pzvar = var;
+
+ free (ww);
+ return 0;
}
-double xxlike(int m, double a, double var, double logsum , double lsum)
+double
+xxlike (int m, double a, double var, double logsum, double lsum)
{
- double p , yl = 0.0 ;
- double ym , x ;
- int j ;
-
- p = 0.5* (double) (m+1) ;
- ym = (double) m ;
-
- yl = -ym*a*log(2.0) ;
- for (j=1; j<= m; ++j) {
- x = a - 0.5* (double) (m-j) ;
- yl -= lgamma(x) ;
- }
+ double p, yl = 0.0;
+ double ym, x;
+ int j;
+
+ p = 0.5 * (double) (m + 1);
+ ym = (double) m;
+
+ yl = -ym * a * log (2.0);
+ for (j = 1; j <= m; ++j)
+ {
+ x = a - 0.5 * (double) (m - j);
+ yl -= lgamma (x);
+ }
// so far this is log (C_L) normalizing constant
- yl -= ym*a*log(var) ;
- yl += (a-p)*logsum ;
- yl -= lsum/(2.0*var) ;
+ yl -= ym * a * log (var);
+ yl += (a - p) * logsum;
+ yl -= lsum / (2.0 * var);
- return yl ;
+ return yl;
}
-double xxlikex(int m, double a, double logsum , double lsum)
+double
+xxlikex (int m, double a, double logsum, double lsum)
{
- double p , yl = 0.0 ;
- double ym , x, var, lco ;
- int j ;
-
- p = 0.5* (double) (m+1) ;
- ym = (double) m ;
- lco = lsum/(2.0*ym) ;
- var = lco/a ;
-
-
- yl = -ym*a*log(2.0) ;
- for (j=1; j<= m; ++j) {
- x = a - 0.5* (double) (m-j) ;
- yl -= lgamma(x) ;
- }
+ double p, yl = 0.0;
+ double ym, x, var, lco;
+ int j;
+
+ p = 0.5 * (double) (m + 1);
+ ym = (double) m;
+ lco = lsum / (2.0 * ym);
+ var = lco / a;
+
+ yl = -ym * a * log (2.0);
+ for (j = 1; j <= m; ++j)
+ {
+ x = a - 0.5 * (double) (m - j);
+ yl -= lgamma (x);
+ }
// so far this is log (C_L) normalizing constant
- yl -= ym*a*log(var) ;
- yl += (a-p)*logsum ;
- yl -= ym*a ; // plugging in var
+ yl -= ym * a * log (var);
+ yl += (a - p) * logsum;
+ yl -= ym * a; // plugging in var
- return yl ;
+ return yl;
}
-double xxliked(int m, double a, double logsum , double lsum)
+double
+xxliked (int m, double a, double logsum, double lsum)
// first deriv wrt a
{
- double p , yl = 0.0 ;
- double ym , x, var, vard ;
- int j ;
-
- p = 0.5* (double) (m+1) ;
- ym = (double) m ;
- var = lsum/ (2.0*a*ym) ;
- vard = -var/a ;
-
-
- yl = -ym*log(2.0) ;
- for (j=1; j<= m; ++j) {
- x = a - 0.5* (double) (m-j) ;
- if (x<0.0) return 100.0 ;
- yl -= psi(x) ;
- }
+ double p, yl = 0.0;
+ double ym, x, var, vard;
+ int j;
+
+ p = 0.5 * (double) (m + 1);
+ ym = (double) m;
+ var = lsum / (2.0 * a * ym);
+ vard = -var / a;
+
+ yl = -ym * log (2.0);
+ for (j = 1; j <= m; ++j)
+ {
+ x = a - 0.5 * (double) (m - j);
+ if (x < 0.0)
+ return 100.0;
+ yl -= psi (x);
+ }
// so far this is log (C_L) normalizing constant
- yl -= ym*log(var) ;
- yl -= (ym*a/var)*vard ;
- yl += logsum ;
- yl -= ym ; // plugging in var
+ yl -= ym * log (var);
+ yl -= (ym * a / var) * vard;
+ yl += logsum;
+ yl -= ym; // plugging in var
- return yl ;
+ return yl;
}
-double xxliked2(int m, double a, double logsum , double lsum)
+double
+xxliked2 (int m, double a, double logsum, double lsum)
// second deriv wrt a
{
- double p , yl = 0.0 ;
- double ym , x, var, vard, vard2, y ;
- int j ;
-
- p = 0.5* (double) (m+1) ;
- ym = (double) m ;
- var = lsum/ (2.0*a*ym) ;
- vard = -var/a ;
- vard2 = 2.0*var/(a*a) ;
-
-
- yl = 0.0 ;
- for (j=1; j<= m; ++j) {
- x = a - 0.5* (double) (m-j) ;
- if (x<0.0) return 100.0 ;
- yl -= tau(x) ;
- }
+ double p, yl = 0.0;
+ double ym, x, var, vard, vard2, y;
+ int j;
+
+ p = 0.5 * (double) (m + 1);
+ ym = (double) m;
+ var = lsum / (2.0 * a * ym);
+ vard = -var / a;
+ vard2 = 2.0 * var / (a * a);
+
+ yl = 0.0;
+ for (j = 1; j <= m; ++j)
+ {
+ x = a - 0.5 * (double) (m - j);
+ if (x < 0.0)
+ return 100.0;
+ yl -= tau (x);
+ }
// so far this is log (C_L) normalizing constant
- yl -= 2.0*(ym/var)*vard ;
- yl -= (ym*a/var)*vard2 ;
- y = vard/var ;
- yl += (ym*a)*y*y ;
+ yl -= 2.0 * (ym / var) * vard;
+ yl -= (ym * a / var) * vard2;
+ y = vard / var;
+ yl += (ym * a) * y * y;
- return yl ;
+ return yl;
}
-double doeig2(double *vals, int m, double *pzn, double *ptw)
+double
+doeig2 (double *vals, int m, double *pzn, double *ptw)
{
- static int ncall = 0 ;
- double y, tw, tail ;
- double zn, zvar, top, bot ;
- double *evals ;
-
- ++ncall ;
- ZALLOC(evals, m, double) ;
- copyarr(vals, evals, m) ;
- y = (double) m / asum(evals, m) ;
- vst(evals, evals, y, m) ;
- top = (double) (m*(m+2)) ;
- bot = asum2(evals, m) - (double) m ;
- zn = top/bot ;
- y = evals[0]*zn ;
- tw = twnorm(y, (double) m, zn) ;
- tail = twtail(tw) ;
- free(evals) ;
- *pzn = zn ;
- *ptw = tw ;
- return tail ;
+ static int ncall = 0;
+ double y, tw, tail;
+ double zn, zvar, top, bot;
+ double *evals;
+
+ ++ncall;
+ ZALLOC(evals, m, double);
+ copyarr (vals, evals, m);
+ y = (double) m / asum (evals, m);
+ vst (evals, evals, y, m);
+ top = (double) (m * (m + 2));
+ bot = asum2 (evals, m) - (double) m;
+ zn = top / bot;
+ y = evals[0] * zn;
+ tw = twnorm (y, (double) m, zn);
+ tail = twtail (tw);
+ free (evals);
+ *pzn = zn;
+ *ptw = tw;
+ return tail;
}
-double rhoinv(double x, double gam)
+double
+rhoinv (double x, double gam)
// Lee et al. page 5 for \rho^{-1}
{
- double y1, y2 ;
+ double y1, y2;
- y1 = x + 1.0 - gam ;
- y2 = y1*y1-4.0*x ;
- if (y2 <= 0.0) return -1.0 ;
+ y1 = x + 1.0 - gam;
+ y2 = y1 * y1 - 4.0 * x;
+ if (y2 <= 0.0)
+ return -1.0;
- y1 += sqrt(y2) ;
+ y1 += sqrt (y2);
- return 0.5*y1 ;
+ return 0.5 * y1;
}
-
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/eigensoft.git
More information about the debian-med-commit
mailing list