← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mricron/utopic

« back to all changes in this revision

Viewing changes to fdr.pas

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2010-07-29 22:07:43 UTC
  • Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
Import upstream version 0.20100725.1~dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
fdr.pas
 
1
unit fdr;
 
2
interface
 
3
 
 
4
uses define_types;
 
5
procedure EstimateFDR2(lnTests: integer; var Ps: SingleP; var lFDR05, lFDR01,lnegFDR05, lnegFDR01: double);
 
6
procedure qsort(lower, upper : integer; var Data:SingleP);
 
7
implementation
 
8
 
 
9
procedure qsort(lower, upper : integer; var Data:SingleP);
 
10
//40ms - very recursive...
 
11
var
 
12
       left, right : integer;
 
13
       pivot,lswap: single;
 
14
begin
 
15
     pivot:=Data^[(lower+upper) div 2];
 
16
     left:=lower;
 
17
     right:=upper;
 
18
     while left<=right do begin
 
19
             while Data^[left]  < pivot do left:=left+1;  { Parting for left }
 
20
             while Data^[right] > pivot do right:=right-1;{ Parting for right}
 
21
             if left<=right then begin   { Validate the change }
 
22
                 lswap := Data^[left];
 
23
                 Data^[left] := Data^[right];
 
24
                 Data^[right] := lswap;
 
25
                 left:=left+1;
 
26
                 right:=right-1;
 
27
             end; //validate
 
28
     end;//while left <=right
 
29
     if right>lower then qsort(lower,right,Data); { Sort the LEFT  part }
 
30
     if upper>left  then qsort(left ,upper,data); { Sort the RIGHT part }
 
31
end;
 
32
 
 
33
procedure EstimateFDR2(lnTests: integer; var Ps: SingleP; var lFDR05, lFDR01,lnegFDR05, lnegFDR01: double);
 
34
var
 
35
        lInc: integer;
 
36
        lrPs,Qs: SingleP;
 
37
begin
 
38
        //rank Pvalues
 
39
        //ShaQuickSort(lnTests,Singlep0(Ps[1]));
 
40
        qSort(1,lnTests,Ps);
 
41
        //qcksrt(1,lnTests,Ps);
 
42
        GetMem(Qs,lnTests*sizeof(single));
 
43
        //next findcrit FDR05
 
44
        for lInc := 1 to lnTests do
 
45
                Qs^[lInc] := (0.05*lInc)/lnTests;
 
46
        lFDR05 := 0;
 
47
        for lInc := 1 to lnTests do
 
48
                if Ps^[lInc] <= Qs^[lInc] then
 
49
                                lFDR05 := Ps^[lInc];
 
50
        //next findcrit FDR01
 
51
        for lInc := 1 to lnTests do
 
52
                Qs^[lInc] := (0.01*lInc)/lnTests;
 
53
        lFDR01 := 0;
 
54
        for lInc := 1 to lnTests do
 
55
                if Ps^[lInc] <= Qs^[lInc] then
 
56
                                lFDR01 := Ps^[lInc];
 
57
        //reverse
 
58
        GetMem(lrPs,lnTests*sizeof(single));
 
59
        for lInc := 1 to lnTests do
 
60
                lrPs^[lInc] := 1- Ps^[lnTests-lInc+1];
 
61
        for lInc := 1 to lnTests do
 
62
                Qs^[lInc] := (0.05*lInc)/lnTests;
 
63
        lnegFDR05 := 0;
 
64
        for lInc := 1 to lnTests do
 
65
                if lrPs^[lInc] <= Qs^[lInc] then
 
66
                                lnegFDR05 := lrPs^[lInc];
 
67
        //next findcrit FDR01
 
68
        for lInc := 1 to lnTests do
 
69
                Qs^[lInc] := (0.01*lInc)/lnTests;
 
70
        lnegFDR01 := 0;
 
71
        for lInc := 1 to lnTests do
 
72
                if lrPs^[lInc] <= Qs^[lInc] then
 
73
                                lnegFDR01 := lrPs^[lInc];
 
74
        FreeMem(lrPs);
 
75
        Freemem(Qs);
 
76
end;
 
77
 
 
78
end.