Mercurial > hg > medcouple

annotate mlmc.c @ 74:305b7361a5bd default tip @

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
showalgo: save a snapshot instead of waiting for keyboard input
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Sun, 29 May 2016 19:05:01 -0400
parents 8e35dcdb8dec
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
17
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 #include<stdlib.h>
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 #include<math.h>
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /*matlabmc.c
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5 Algorithm for the skewness estimator medcouple (MC)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7 Needed variables:
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8 x: real array containing observations
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 n: number of observations (n>=2)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 Includes the functions
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 *whimed(a,iw,n): finds the weighted high median of an array a of length n, using the array iw
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 (also of length n) with positive longinteger weights.
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 *sort(x,n,y): sorts an array x of length n and stores the result in an array y (of size at least n)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 *pull(a,n,k): finds the k-th order statistic of an array a of length n
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 *calwork(a,b,ai,bi,ab,eps): calculates the values needed to compute the mc
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 NOTE: array[0] is empty
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 */
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 /*declaration of functions*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 #define TRUE 1
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 #define FALSE 0
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 void sort(double x[],long n, double y[]);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 double pull(double a[],long n, long k);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 double whimed(double a[],long iw[],long n);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 double calwork(double a,double b,long ai,long bi,long ab,double eps);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 void mlmc(double *out, double z[],long *in)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 double medc,xmed2,yden,xmed,trial,eps;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 double *work,*y,*x,*y1,*y2;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 long *left,*right,*weight,*q,*p;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 long k,knew,nl,nr,sumq,sump,i,j,jj,IsFound,h1,h2,n;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 n=*in;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 y=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 x=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 y1=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 y2=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 work=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 left=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 right=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 weight=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 q=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 p=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 eps=0.0000000000001;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 x[0]=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 for (i=0;i<n;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 x[i+1]=-z[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 xmed=pull(x,n,floor(n/2)+1);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 if (n%2 == 0)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 xmed2=pull(x,n,floor(n/2));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 xmed=(xmed+xmed2)/2;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 for (i=1;i<=n;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 x[i]=x[i]-xmed;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 sort(x,n,y);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 if (-y[1] > y[n])
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 yden=-2*y[1];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 yden=2*y[n];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 for (i=1;i<=n;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 y[i]=-y[i]/yden;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 j=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 while (y[j] > eps)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 y1[j]=y[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 i=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 while (y[j] > -eps)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 y1[j]=y[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 y2[i]=y[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 i++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 h1=j-1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 while (j < n+1)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 y2[i]=y[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 i++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 h2=i-1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 left[i]=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 right[i]=h1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 nl=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 nr=h1*h2;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 knew=floor(nr/2)+1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 IsFound=FALSE;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 while ((nr-nl>n)& (!IsFound))
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 j=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 if (left[i]<=right[i])
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 weight[j]=right[i]-left[i]+1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 k = left[i]+floor(weight[j]/2);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 work[j]=calwork(y1[k],y2[i],k,i,h1+1,eps);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 trial=whimed(work,weight,j-1);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 j=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 for (i=h2;i>=1;i--)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 while ((j<=h1)&(calwork(y1[j],y2[i],j,i,h1+1,eps)>trial))
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 p[i]=j-1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 j=h1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 while ((j>=1)&(calwork(y1[j],y2[i],j,i,h1+1,eps)<trial))
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 j--;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 q[i]=j+1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 sump=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 sumq=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 sump=sump+p[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 sumq=sumq+q[i]-1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 if (knew<=sump)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 right[i]=p[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 nr=sump;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 if (knew>sumq)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 left[i]=q[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171 nl=sumq;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 medc=trial;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 IsFound=TRUE;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 } /*end while-lus*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 if (!IsFound)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 j=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 for (i=1;i<=h2;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 if (left[i]<=right[i])
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 for (jj=left[i];jj<=right[i];jj++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 work[j]=-calwork(y1[jj],y2[i],jj,i,h1+1,eps);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 j++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 medc=pull(work,j-1,knew-nl);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 medc=-medc;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 free(y);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 free(x);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 free(y1);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 free(y2);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 free(work);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 free(left);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 free(right);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 free(weight);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 free(p);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 free(q);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 *out=medc;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 /*sort*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 void sort(double a[],long n, double b[])
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 double xx,amm;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 long i,jss,jndl,jr,jnc,j,jtwe;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 long *jlv,*jrv;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 jlv=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 jrv=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 for (i=1;i<=n;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 b[i]=a[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 jss=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 jlv[1]=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 jrv[1]=n;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 do
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 jndl=jlv[jss];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 jr=jrv[jss];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237 jss=jss-1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 do
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 jnc=jndl;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 j=jr;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 jtwe=floor((jndl+jr)/2);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 xx=b[jtwe];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 do
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 while (b[jnc]<xx)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 jnc++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 while (xx<b[j])
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 j--;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 if (jnc<=j)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256 amm=b[jnc];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 b[jnc]=b[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258 b[j]=amm;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 jnc++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260 j--;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262 } while (jnc<=j) ;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263 if ((j-jndl)>=(jr-jnc))
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 if (jndl<j)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 jss++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268 jlv[jss]=jndl;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 jrv[jss]=j;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 jndl=jnc;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 if (jnc<jr)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 jss++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278 jlv[jss]=jnc;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 jrv[jss]=jr;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 jr=j;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 } while (jndl<jr);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 } while (jss!=0);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285 free(jrv);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 free(jlv);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 /*pull*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 double pull(double a[],long n, long k)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293 double* b;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 double outp,ax,buffer;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 long l,lr,jnc,j,i;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 b=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298 for (i=1;i<=n;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300 b[i]=a[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302 l=1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 lr=n;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304 while (l<lr)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306 ax=b[k];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 jnc=l;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 j=lr;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 while (jnc<=j)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 while (b[jnc]<ax)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313 jnc++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315 while (b[j]>ax)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317 j--;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 if (jnc<=j)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
321 buffer=b[jnc];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
322 b[jnc]=b[j];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
323 b[j]=buffer;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
324 jnc++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
325 j--;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
326 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
327 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
328 if (j<k)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
329 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
330 l=jnc;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
331 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
332 if (k<jnc)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
333 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
334 lr=j;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
335 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
336 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
337 outp=b[k];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
338 free(b);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
339 return(outp);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
340 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
341
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
342
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
343 double whimed(double a[],long iw[],long n)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
344
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
345 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
346 double* acand;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
347 double trial,whmed;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
348 long* iwcand;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
349 long nn;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
350 long i,wtotal,wrest,wleft,wmid,wright,kcand,IsFound;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
351
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
352 acand=(double *) malloc((n+1)*sizeof(double));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
353 iwcand=(long *) malloc((n+1)*sizeof(long));
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
354 nn=n;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
355 wtotal=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
356 for (i=1;i<=nn;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
357 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
358 wtotal+=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
359 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
360 wrest=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
361 IsFound=FALSE;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
362 while (!IsFound)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
363 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
364 wleft=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
365 wmid=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
366 wright=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
367 trial=pull(a,nn,floor(nn/2)+1);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
368 for (i=1;i<=nn;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
369 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
370 if (a[i]<trial)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
371 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
372 wleft+=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
373 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
374 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
375 { if (a[i]>trial)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
376 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
377 wright+=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
378 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
379 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
380 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
381 wmid+=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
382 } /*end else 2*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
383 } /*end else 1*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
384 } /*end for*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
385 if ((2*wrest+2*wleft)>wtotal)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
386 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
387 kcand=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
388 for (i=1;i<=nn;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
389 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
390 if (a[i]<trial)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
391 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
392 kcand++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
393 acand[kcand]=a[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
394 iwcand[kcand]=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
395 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
396 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
397 nn=kcand;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
398 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
399 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
400 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
401 if ((2*wrest+2*wleft+2*wmid) >wtotal)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
402 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
403 whmed=trial;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
404 IsFound=TRUE;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
405 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
406 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
407 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
408 kcand=0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
409 for (i=1;i<=nn;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
410 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
411 if (a[i]>trial)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
412 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
413 kcand++;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
414 acand[kcand]=a[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
415 iwcand[kcand]=iw[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
416 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
417 }/*end for*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
418 nn=kcand;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
419 wrest=wrest+wleft+wmid;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
420
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
421 } /*end else 2*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
422 } /*end else 1*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
423 for(i=1;i<=nn;i++)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
424 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
425 a[i]=acand[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
426 iw[i]=iwcand[i];
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
427 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
428 }/*end while*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
429 free(iwcand);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
430 free(acand);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
431 return(whmed);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
432 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
433
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
434 /*calwork*/
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
435
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
436 double calwork(double a,double b,long ai,long bi,long ab,double eps)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
437
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
438 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
439 double cwork;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
440
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
441 if (fabs(a-b) < 2.0*eps)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
442 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
443 if (ai+bi == ab)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
444 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
445 cwork = 0;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
446 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
447 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
448 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
449 if (ai+bi < ab)
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
450 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
451 cwork = 1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
452 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
453 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
454 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
455 cwork = -1;
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
456 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
457 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
458 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
459 else
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
460 {
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
461 cwork = (a+b)/(a-b);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
462 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
463 return(cwork);
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
464 }
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
465
8e35dcdb8dec Add missing mlmc for MEX medcouple
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
466