Error determining type for input 'conscalc: calc '. Cannot union coder.StructTypes with different sets of fields - c++

When I try to convert a Matlab program as a group which includes several functions to C++ program by Matlab coder app, I get a error says this:
enter image description here.And variable calc is a struct in Matlab. However, if I try the function conscalc itself, there is no problem at all.
What is the problem?
Here is the code of function conscalc:
function [calc] = conscalc(rho, gv, calc)
tp = 1 + rho;
sqrt2 = sqrt(2);
consadj = 2 ^ (0.5 * (1 - calc.alpha));
% initialization;
cv = zeros(gv.nacatlim, 1); % consumption equivalents of future expected marginal utility;
yac = zeros(gv.nacatlim, 1); % income (y) - end of period asset (a) - optimal consumption given end of period asse (c);
margu = zeros(gv.nvcatlim, gv.nacatlim); % marginal utility next period by next period survival status (1 - 3) and initial asset (1 - gv.nacatlim);
cons = zeros(gv.T - gv.beginage + 1, gv.nvcatlim, gv.nacatlim); % optimal consumption at the current period by age (25 - 99), survival status (1 - 3) and initial asset (1 - gv.nacatlim);
% simplified backward induction;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% calculate optimal consumption and marginal utility for the terminal age %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% the optimal decision is to consume everything at the terminal age;
for vcat = 1: 3; % survival status;
for acat = 1 : gv.nacatlim; % asset;
y = calc.acats(acat, 1) + calc.income(vcat, gv.T - gv.beginage + 1); % total resources in the last period given initial asset and income;
mu = y ^ (calc.alpha - 1); % marginal utility given next period survival status and initial asset;
if vcat == 1; % married couple adjustment;
mu = consadj * mu;
end;
% save to marginal utility next period (when calculating backward to age - 1) for later calculations;
margu(vcat, acat) = mu;
end;
end;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% calculate optimal consumption and marginal utility for ages gv.t to gv.T - 1 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
for age = gv.T - 1 : -1 : gv.beginage; % age;
for vcat = 1 : 3; % survival status;
y = calc.income(vcat, age - gv.beginage + 1); % income given survival status and age;
% calculate expected marginal utility next period given current period end of period asset;
for acat = 1 : gv.nacatlim; % asset;
mu = 0; % expected marginal utility next period given current period survival status and end of period asset;
for rcat = 1 : gv.nrcatlim; % asset return shock;
mur = 0; % marginal utility next period given current period survival status, end of period asset and asset return shock;
% (end of period asset + saving) * asset return shock is asset next period;
% interpolation;
% find corresponding asset grid point of the next period initial asset given current period end of period asset and asset return shock;
acatf = floor(calc.rtransa(acat, rcat));
if acatf >= gv.nacatlim;
acatf = gv.nacatlim - 1;
end;
fa = calc.rtransa(acat, rcat) - acatf;
for vcatt = 1 : 3; % survival status next period;
if vcatt == 1 || (vcat == 1 && age >= gv.surviveage); % the codes are not right. if vcat == 2/3, the program uses margu(1, acatf); should use margu(2/3, acatf); ???
mu0 = margu(vcatt, acatf);
mu1 = margu(vcatt, acatf + 1);
if mu0 <= 0 || mu1 <= 0;
fprintf('Interpolaton Error: Bad mu in rho section: %2d %2d %14.6e %14.6e %2d %2d %2d', ...
calc.obs, age, mu0, mu1, vcat, acat, rcat);
return;
end;
if fa <= 1;
murv = (1 - fa) * mu0 + fa * mu1;
else
if mu0 > mu1;
dmu = mu0 - mu1;
mufact = dmu / mu0;
murv = mu1 / (1 + (fa - 1) * mufact);
else
murv = mu1;
end;
end;
if vcat == 1 && age >= gv.surviveage; % both spouses alive;
mur = mur + calc.transrate(vcatt, age - gv.beginage + 1) * murv;
else
mur = mur + murv;
end;
end;
end;
mu = mu + calc.rprob(rcat, 1) * mur;
end;
% marginal utility this period should equal to the discounted expected marginal utility next period;
% convert optimal discounted expected marginal utility back to consumption level;
if vcat == 1; % both spouses alive;
cv(acat, 1) = sqrt2 * (mu / tp) ^ (1 / (calc.alpha - 1));
elseif vcat == 2 || vcat == 3; % only one spouse alive;
cv(acat, 1) = (mu * calc.srate(vcat - 1, age - gv.beginage + 1) / tp) ^ (1 / (calc.alpha - 1));
end;
yac(acat, 1) = y - calc.acats(acat, 1) - cv(acat, 1); % income - end of period asset - consumption;
end;
% find optimal consumption at the current period given initial asset;
k = 1; % initialize asset grid point;
for acat = 1 : gv.nacatlim; % asset;
nassets = - calc.acats(acat, 1); % - initial asset level at the current period;
% find how much asset left after consumption;
% - asset(t) = income - end of period asset(t) - optimal consumption(t) given end of period asset(t);
% interpolation;
if yac(k, 1) < nassets;
k = k - 1;
while k >= 1 && yac(k, 1) < nassets;
k = k - 1;
end;
if k < 1; % optimal to leave no assets to next period;
f = 0;
k = 1;
elseif k >= 1;
f = (yac(k, 1) - nassets) / (yac(k, 1) - yac(k + 1, 1));
end;
elseif yac(k, 1) >= nassets;
while k < gv.nacatlim && yac(k + 1, 1) >= nassets;
k = k + 1;
end;
if k > gv.nacatlim - 1; % requires extrapolation;
k = gv.nacatlim - 1;
if cv(k + 1, 1) > cv(k, 1);
f = (yac(k, 1) - nassets) / (yac(k, 1) - yac(k + 1, 1));
else
f = 1 + (yac(k + 1, 1) - nassets) / (calc.acats(k + 1, 1) - calc.acats(k, 1));
end;
elseif k <= gv.nacatlim - 1;
f = (yac(k, 1) - nassets) / (yac(k, 1) - yac(k + 1, 1));
end;
end;
c = y + calc.acats(acat, 1) - ((1 - f) * calc.acats(k, 1) + f * calc.acats(k + 1, 1)); % optimal consumption at the current period;
% calculate marginal utility at the current period given optimal consumption;
if vcat == 1; % married couple adjustment;
mu = consadj * c ^ (calc.alpha - 1);
elseif vcat == 2 || vcat == 3;
mu = c ^ (calc.alpha - 1);
end;
% save optimal consumption to corresponding optimal consumption matrix for later calculations;
cons(age - gv.beginage + 1, vcat, acat) = c; % optimal consumption at the current period;
margu(vcat, acat) = mu; % marginal utility next period (when calculating backward at age - 1), given survival status and initial asset;
end;
end;
end;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% assign the values to structure variable calc for future calculations %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
calc.cons = cons;
end


The error suggests that during the automatic input type definition your function is called with structures that have different sets of fields.
To debug, put a breakpoint in your entry-point function in MATLAB and run your input definition test script. Take note of the structures being passed in to see where the mismatch originates.

Related

modulo formula in C++

I Have this formula:
(n - 1)! ((n (n - 1))/2 + ((n - 1) (n - 2))/4)
2<=n<=100000
I would like to modulate the result of this from this formula by any modulo, but for the moment let's assume that it is constant, MOD = 999999997. Unfortunately I can't just calculate the result and modulate it, because unfortunately I don't have variables larger than 2^64 at my disposal, so the main question is. What factors to modulate by MOD to get the results%MOD ?
Now let's assume that n=19. What is in brackets is equal to 247.5
18! = 6402373705728000.
(6402373705728000 * 247.5)mod999999997 = 921442488.
Unfortunately, in case I modulate 18! first, the result will be wrong, because (18!)mod999999997 = 724935119. (724935119 * 247.5)mod9999997 = 421442490.
How to solve this problem?

I think the sum could be break down. The only tricky part here is that (n - 1)(n - 2)/4 may have a .5 decimal., as n(n-1) / 2 will always be integer.
S = (n - 1)! * ((n (n - 1))/2 + ((n - 1) (n - 2))/4)
= [(n-1)! * (n*(n-1)/2)] + [(n-1)! * (n-1)(n-2)/4]
= A + B
A is easy to do. With B, if (n-1)(n-2) % 4 == 0 then there's nothing else either, else you can simplified to X/2, as (n-1)(n-2) is also divisible by 2.
If n = 2, it's trivial, else if n > 2 there's always a 2 in the representation of (N-1)! = 1x2x3x ... xN. In that case, simply calculate ((N-1)!/2) = 1x3x4x5x ... xN.
Late example:
N = 19
MOD = 999999997
--> 18! % MOD = 724935119 (1)
(18!/2) % MOD = 862467558 (2)
n(n-1)/2 = 171 (3)
(n-1)(n-2)/2 = 153 (4)
--> S = (1)*(3) + (2)*(4) = 255921441723
S % MOD = 921442488
On another note, if mod is some prime number, like 1e9+7, you can just apply Fermat's little theorem to calculate multiplicative inverse as such:
(a/b) % P = [(a%P) * ((b^(P-2)) % P)] % P (with P as prime, a and b are co-prime to P)

You will have to use 2 mathematical formulas here:
(a + b) mod c == (a mod c + b mod c) mod c
and
(a * b) mod c == (a mod c * b mod c) mod c
But those are only valid for integers. The nice part here is that formula can only be integer for n >= 2, provided you compute it as:
(((n - 1)! * n * (n - 1))/2) + (((n - 1)! * (n - 1) * (n - 2))/4)
1st part is integer | 2nd part is too
for n == 2, first part boils down to 1 and second is 0
for n > 2 either n or n-1 is even so first part is integer, and again eithe n-1 of n-2 is even and (n-1)! is also even so second part is integer. As your formula can be rewritten to only use additions and multiplications it can be computed.
Here is a possible C++ code (before unsigned long long is required):
#include <iostream>
template<class T>
class Modop {
T mod;
public:
Modop(T mod) : mod(mod) {}
T add(T a, T b) {
return ((a % mod) + (b % mod)) % mod;
}
T mul(T a, T b) {
return ((a % mod) * (b % mod)) % mod;
}
int fact_2(T n) {
T cr = 1;
for (T i = 3; i <= n; ++i) {
cr = mul(cr, i);
}
return cr;
}
};
template<class T>
T formula(T n, T mod) {
Modop<T> op = mod;
if (n == 2) {
return 1;
}
T second, first = op.mul(op.fact_2(n - 1), op.mul(n, n - 1));
if (n % 2 == 0) {
second = op.mul(op.fact_2(n - 1), op.mul((n - 2)/ 2, n - 1));
}
else {
second = op.mul(op.fact_2(n - 1), op.mul(n- 2, (n - 1) / 2));
}
return op.add(first, second);
}
int main() {
std::cout << formula(19ull, 999999997ull) << std::endl;
return 0;
}

First of All , for n=2 we can say that the result is 1.
Then, the expression is equal to: (n*(n-1)(n-1)!)/2 + (((n-1)(n-2)/2)^2)*(n-3)! .
lemma: For every two consecutive integer number , one of them is even.
By lemma we can understand that n*(n-1) is even and also (n-1)*(n-2) is even too. So we know that the answer is an integer number.
First we calculate (n*(n-1)(n-1)!)/2 modulo MOD. We can calculate (n(n-1))/2 that can be saved in a long long variable like x, and we get the mod of it modulo MOD:
x = (n*(n-1))/2;
x %= MOD;
After that for: i (n-1 -> 1) we do:
x = (x*i)%MOD;
And we know that both of 'x' and 'i' are less than MOD and the result of
multiplication can be save in a long long variable.
And likewise we do the same for (((n-1)(n-2)/2)^2)(n-3)! .
We calculate (n-1)*(n-2)/2 that can be save in a long long variable like y, and we get the mod of it modulo MOD:
y = ((n-1)*(n-2))/2;
y %= MOD;
And after that we replace (y^2)%MOD on y because we know that y is less than MOD and y*y can be save in a long long variable:
y = (y*y)%MOD;
Then like before for: i (n-3 -> 1) we do:
y = (y*i)%MOD;
And finally the answer is (x+y)%MOD

Why polyxpoly does not work in GNU octave

I want to plot Det curve and roc curve Why polyxpoly does not work?
I plotted a DET curve based on the following steps: First, I changed the threshold and count the number of false rejections and false acceptances. Second, I use plot MATLAB function to draw FAR and FRR.
function [TPR,FPR] = DETCurve(G,I)
#load('G.dat');
#load('I.dat');
#load data from the column 4 fscore
i0=find(Fscore(:,end)==0);
i1=find(Fscore(:,end)==1);
D0=Fscore(i0,end-1);
D1=Fscore(i1,end-1);
% Creates a matrix
TPR = zeros(1, 1000);
FPR = zeros(1, 1000);
#number of positive responses and negative responses in ground truth
P = length(i1);
N = length(i0);
index = 0;
% Assume the threshold as 0.01
for threshold = 0:0.001:1
TP = 0;
FP = 0;
%Provides the D1 count
for i = 1:length(i1)
if (D1(i) >= threshold) TP = TP + 1;
end
end
% Provides the D0count
for i1 = length(i0)
if(D0(i1) >= threshold)
FP = FP + 1;
end
end
index = index + 1;
% Calculating true positive rate
TPR(index) = TP/P;
% Calculating false positive rate
FPR(index) = FP/N;
end
% Calculating false negative rate(FNR) using TPR+FNR=1
FNR = (1-TPR);
x = 0:0.1:1;
y = x;
#[x(i),y(i)] = polyxpoly(x,y,FPR,FNR);
fprintf('EER(X): %d n', x(i));
fprintf('EER(Y): %d n', y(i));
plot(FPR,FNR,'LineWidth',2, 'color','g');
hold on;
plot(x,y,x,1-y, 'color','r');
plot (x(i),y(i),'X','MarkerSize',10, 'LineWidth', 2,'Color','b');
hold off;
title('DET CURVE');
xlabel('False Positive Rate (FPR) ');
ylabel('False Neagtive Rate (FNR) ');
end

Difference between CBOW and Skipgram gradients in word2vec?

Why are f values that are greater than or lower than MAX_EXP taken into account during the updates in CBOW, but ignored in Skipgram?
I'm specifically looking at the Google implementation of word2vec, but the same functionality has been replicated throughout many other projects, one of which is here, for larger context.
// CBOW negative sampling gradient calculations
f = 0;
l2 = target * layer1_size;
for (c = 0; c < layer1_size; c++) f += neu1[c] * syn1neg[c + l2];
// ** here, we still update, but essentially round the value to 1 or 0
if (f > MAX_EXP) g = (label - 1) * alpha;
else if (f < -MAX_EXP) g = (label - 0) * alpha;
else g = (label - expTable[(int)((f + MAX_EXP) * (EXP_TABLE_SIZE / MAX_EXP / 2))]) * alpha;
// ---------------------------
// Skipgram hierarchical softmax gradient calculations
f = 0;
l2 = vocab[word].point[d] * layer1_size;
for (c = 0; c < layer1_size; c++) f += syn0[c + l1] * syn1[c + l2];
// ** here, we don't update if f is outside the range given by MAX_EXP **
if (f <= -MAX_EXP) continue;
else if (f >= MAX_EXP) continue;
else f = expTable[(int)((f + MAX_EXP) * (EXP_TABLE_SIZE / MAX_EXP / 2))];
g = (1 - vocab[word].code[d] - f) * alpha;

Time complexity of recursive algorithm with two recursive calls

I am trying to analyze the Time Complexity of a recursive algorithm that solves the Generate all sequences of bits within Hamming distance t problem. The algorithm is this:
// str is the bitstring, i the current length, and changesLeft the
// desired Hamming distance (see linked question for more)
void magic(char* str, int i, int changesLeft) {
if (changesLeft == 0) {
// assume that this is constant
printf("%s\n", str);
return;
}
if (i < 0) return;
// flip current bit
str[i] = str[i] == '0' ? '1' : '0';
magic(str, i-1, changesLeft-1);
// or don't flip it (flip it again to undo)
str[i] = str[i] == '0' ? '1' : '0';
magic(str, i-1, changesLeft);
}
What is the time complexity of this algorithm?
I fond myself pretty rusty when it comes to this and here is my attempt, which I feel is no where near the truth:
t(0) = 1
t(n) = 2t(n - 1) + c
t(n) = t(n - 1) + c
= t(n - 2) + c + c
= ...
= (n - 1) * c + 1
~= O(n)
where n is the length of the bit string.
Related questions: 1, 2.

It's exponential:
t(0) = 1
t(n) = 2 t(n - 1) + c
t(n) = 2 (2 t(n - 2) + c) + c = 4 t (n - 2) + 3 c
= 2 (2 (2 t(n - 3) + c) + c) + c = 8 t (n - 3) + 7 c
= ...
= 2^i t(n-i) + (2^i - 1) c [at any step i]
= ...
= 2^n t(0) + (2^n - 1) c = 2^n + (2^n - 1) c
~= O(2^n)
Or, using WolframAlpha: https://www.wolframalpha.com/input/?i=t(0)%3D1,+t(n)%3D2+t(n-1)+%2B+c
The reason it's exponential is that your recursive calls are reducing the problem size by 1, but you're making two recursive calls. Your recursive calls are forming a binary tree.

6 dimensional integral by Trapezoid in Fortran using Fortran 90

I need to calculate six dimensional integrals using Trapezoid in Fortran 90 in an efficient way. Here is an example of what I need to do:
Where F is a numerical (e.g. not analytical) function which is to be integrated over x1 to x6, variables. I have initially coded a one dimension subroutine:
SUBROUTINE trapzd(f,mass,x,nstep,deltam)
INTEGER nstep,i
DOUBLE PRECISION mass(nstep+1),f(nstep+1),x,deltam
x=0.d0
do i=1,nstep
x=x+deltam*(f(i)+f(i+1))/2.d0
end do
return
END
Which seems to work fine with one dimension, however, I don't know how to scale this up to six dimensions. Can I re-use this six times, once for every dimension or shall I write a new subroutine?
If you have a fully coded (no library/API use) version of this in another language like Python, MATLAB or Java, I'd be very glad to have a look and get some ideas.
P.S. This is not school homework. I am a PhD student in Biomedicine and this is part of my research in modeling stem cell activities. I do not have a deep background of coding and mathematics.
Thank you in advance.

You could look at the Monte Carlo Integration chapter of the GNU Scientific Library (GSL). Which is both a library, and, since it is open source, source code that you can study.

Look at section 4.6 of numerical recipes for C.
Step one is to reduce the problem using, symmetry and analytical dependencies.
Step two is to chain the solution like this:
f2(x2,x3,..,x6) = Integrate(f(x,x2,x3..,x6),x,1,x1end)
f3(x3,x4,..,x6) = Integrate(f2(x,x3,..,x6),x,1,x2end)
f4(x4,..,x6) = ...
f6(x6) = Integrate(I4(x,x6),x,1,x5end)
result = Integrate(f6(x),x,1,x6end)

Direct evaluation of multiple integrals is computationally challenging. It might be better to use Monte Carlo, perhaps using importance sampling. However brute force direct integration is sometimes of interest for validation of methods.
The integration routine I use is "QuadMo" written by Luke Mo about 1970. I made it recursive and put it in a module. QuadMo refines the mesh were needed to get the requested integration accuracy. Here is a program that does an n-dimensional integral using QuadMo.
Here is the validation of the program using a Gaussian centered at 0.5 with SD 0.1 in all dimensions for nDim up to 6, using a G95 compile. It runs in a couple of seconds.
nDim ans expected nlvl
1 0.249 0.251 2
2 6.185E-02 6.283E-02 2 2
3 1.538E-02 1.575E-02 2 2 2
4 3.826E-03 3.948E-03 2 2 2 2
5 9.514E-04 9.896E-04 2 2 2 2 2
6 2.366E-04 2.481E-04 2 2 2 2 2 2
Here is the code:
!=======================================================================
module QuadMo_MOD
implicit none
integer::QuadMo_MinLvl=6,QuadMo_MaxLvl=24
integer,dimension(:),allocatable::QuadMo_nlvlk
real*8::QuadMo_Tol=1d-5
real*8,save,dimension(:),allocatable::thet
integer,save::nDim
abstract interface
function QuadMoFunct_interface(thet,k)
real*8::QuadMoFunct_interface
real*8,intent(in)::thet
integer,intent(in),optional::k
end function
end interface
abstract interface
function MultIntFunc_interface(thet)
real*8::MultIntFunc_interface
real*8,dimension(:),intent(in)::thet
end function
end interface
procedure(MultIntFunc_interface),pointer :: stored_func => null()
contains
!----------------------------------------------------------------------
recursive function quadMoMult(funct,lower,upper,k) result(ans)
! very powerful integration routine written by Luke Mo
! then at the Stanford Linear Accelerator Center circa 1970
! QuadMo_Eps is error tolerance
! QuadMo_MinLvl determines initial grid of 2**(MinLvl+1) + 1 points
! to avoid missing a narrow peak, this may need to be increased.
! QuadMo_Nlvl returns number of subinterval refinements required beyond
! QuadMo_MaxLvl
! Modified by making recursive and adding argument k
! for multiple integrals (GuthrieMiller#gmail.com)
real*8::ans
procedure(QuadMoFunct_interface) :: funct
real*8,intent(in)::lower,upper
integer,intent(in),optional::k
real*8::Middle,Left,Right,eps,est,fLeft,fMiddle,fRight
& ,fml,fmr,rombrg,coef,estl,estr,estint,area,abarea
real*8::valint(50,2), Middlex(50), Rightx(50), fmx(50), frx(50)
& ,fmrx(50), estrx(50), epsx(50)
integer retrn(50),i,level
level = 0
QuadMo_nlvlk(k) = 0
abarea = 0
Left = lower
Right = upper
if(present(k))then
fLeft = funct(Left,k)
fMiddle = funct((Left+Right)/2,k)
fRight = funct(Right,k)
else
fLeft = funct(Left)
fMiddle = funct((Left+Right)/2)
fRight = funct(Right)
endif
est = 0
eps = QuadMo_Tol
100 level = level+1
Middle = (Left+Right)/2
coef = Right-Left
if(coef.ne.0) go to 150
rombrg = est
go to 300
150 continue
if(present(k))then
fml = funct((Left+Middle)/2,k)
fmr = funct((Middle+Right)/2,k)
else
fml = funct((Left+Middle)/2)
fmr = funct((Middle+Right)/2)
endif
estl = (fLeft+4*fml+fMiddle)*coef
estr = (fMiddle+4*fmr+fRight)*coef
estint = estl+estr
area= abs(estl)+ abs(estr)
abarea=area+abarea- abs(est)
if(level.ne.QuadMo_MaxLvl) go to 200
QuadMo_nlvlk(k) = QuadMo_nlvlk(k)+1
rombrg = estint
go to 300
200 if(( abs(est-estint).gt.(eps*abarea)).or.
1(level.lt.QuadMo_MinLvl)) go to 400
rombrg = (16*estint-est)/15
300 level = level-1
i = retrn(level)
valint(level, i) = rombrg
go to (500, 600), i
400 retrn(level) = 1
Middlex(level) = Middle
Rightx(level) = Right
fmx(level) = fMiddle
fmrx(level) = fmr
frx(level) = fRight
estrx(level) = estr
epsx(level) = eps
eps = eps/1.4d0
Right = Middle
fRight = fMiddle
fMiddle = fml
est = estl
go to 100
500 retrn(level) = 2
Left = Middlex(level)
Right = Rightx(level)
fLeft = fmx(level)
fMiddle = fmrx(level)
fRight = frx(level)
est = estrx(level)
eps = epsx(level)
go to 100
600 rombrg = valint(level,1)+valint(level,2)
if(level.gt.1) go to 300
ans = rombrg /12
end function quadMoMult
!-----------------------------------------------------------------------
recursive function MultInt(k,func) result(ans)
! MultInt(nDim,func) returns multi-dimensional integral from 0 to 1
! in all dimensions of function func
! variable QuadMo_Mod: nDim needs to be set initially to number of dimensions
procedure(MultIntFunc_interface) :: func
real*8::ans
integer,intent(in)::k
stored_func => func
if(k.eq.nDim)then
if(allocated(thet))deallocate(thet)
allocate (thet(nDim))
if(allocated(QuadMo_nlvlk))deallocate(QuadMo_nlvlk)
allocate(QuadMo_nlvlk(nDim))
endif
if(k.eq.0)then
ans=func(thet)
return
else
ans=QuadMoMult(MultIntegrand,0d0,1d0,k)
endif
end function MultInt
!-----------------------------------------------------------------------
recursive function MultIntegrand(thetARG,k) result(ans)
real*8::ans
real*8,intent(in)::thetARG
integer,optional,intent(in)::k
if(present(k))then
thet(k)=thetARG
else
write(*,*)'MultIntegrand: not expected, k not present!'
stop
endif
ans=MultInt(k-1,stored_func)
end function MultIntegrand
!-----------------------------------------------------------------------
end module QuadMo_MOD
!=======================================================================
module test_MOD
use QuadMo_MOD
implicit none
contains
!-----------------------------------------------------------------------
real*8 function func(thet) ! multidimensional function
! this is the function defined in nDim dimensions
! in this case a Gaussian centered at 0.5 with SD 0.1
real*8,intent(in),dimension(:)::thet
func=exp(-sum(((thet-5d-1)/1d-1)
& *((thet-5d-1)/1d-1))/2)
end function func
!-----------------------------------------------------------------------
end module test_MOD
!=======================================================================
! test program to evaluate multiple integrals
use test_MOD
implicit none
real*8::ans
! these values are set for speed, not accuracy
QuadMo_MinLvl=2
QuadMo_MaxLvl=3
QuadMo_Tol=1d-1
write(*,*)' nDim ans expected nlvl'
do nDim=1,6
! expected answer is (0.1 sqrt(2pi))**nDim
ans=MultInt(nDim,func)
write(*,'(i10,2(1pg10.3),999(i3))')nDim,ans,(0.250663)**nDim
& ,QuadMo_nlvlk
enddo
end
!-----------------------------------------------------------------------

double MultInt(int k);
double MultIntegrand(double thetARG, int k);
double quadMoMult(double(*funct)(double, int), double lower, double upper, int k);
double funkn(double *thet);
int QuadMo_MinLvl = 2;
int QuadMo_MaxLvl = 3;
double QuadMo_Tol = 0.1;
int *QuadMo_nlvlk;
double *thet;
int nDim;
//double MultInt(int k, double(*func)(double *))
double MultInt(int k)
{
//MultInt(nDim, func) returns multi - dimensional integral from 0 to 1
//in all dimensions of function func
double ans;
if (k == 0)
{
ans = funkn(thet);
}
else
{
ans = quadMoMult(MultIntegrand, 0.0, 1.0, k); //limits hardcoded here
}
return ans;
}
double MultIntegrand(double thetARG, int k)
{
double ans;
if (k > 0)
thet[k] = thetARG;
else
printf("\n***MultIntegrand: not expected, k not present!***\n");
//Recursive call
//ans = MultInt(k - 1, func);
ans = MultInt(k - 1);
return ans;
}
double quadMoMult(double(*funct)(double, int), double lower, double upper, int k)
{
//Integration routine written by Luke Mo
//Stanford Linear Accelerator Center circa 1970
//QuadMo_Eps is error tolerance
//QuadMo_MinLvl determines initial grid of 2 * *(MinLvl + 1) + 1 points
//to avoid missing a narrow peak, this may need to be increased.
//QuadMo_Nlvl returns number of subinterval refinements required beyond
//QuadMo_MaxLvl
//Modified by making recursive and adding argument k
//for multiple integrals(GuthrieMiller#gmail.com)
double ans;
double Middle, Left, Right, eps, est, fLeft, fMiddle, fRight;
double fml, fmr, rombrg, coef, estl, estr, estint, area, abarea;
double valint[51][3], Middlex[51], Rightx[51], fmx[51], frx[51]; //Jack up arrays
double fmrx[51], estrx[51], epsx[51];
int retrn[51];
int i, level;
level = 0;
QuadMo_nlvlk[k] = 0;
abarea = 0.0;
Left = lower;
Right = upper;
if (k > 0)
{
fLeft = funct(Left, k);
fMiddle = funct((Left + Right) / 2, k);
fRight = funct(Right, k);
}
else
{
fLeft = funct(Left,0);
fMiddle = funct((Left + Right) / 2,0);
fRight = funct(Right,0);
}
est = 0.0;
eps = QuadMo_Tol;
l100:
level = level + 1;
Middle = (Left + Right) / 2;
coef = Right - Left;
if (coef != 0.0)
goto l150;
rombrg = est;
goto l300;
l150:
if (k > 0)
{
fml = funct((Left + Middle) / 2.0, k);
fmr = funct((Middle + Right) / 2.0, k);
}
else
{
fml = funct((Left + Middle) / 2.0, 0);
fmr = funct((Middle + Right) / 2.0, 0);
}
estl = (fLeft + 4 * fml + fMiddle)*coef;
estr = (fMiddle + 4 * fmr + fRight)*coef;
estint = estl + estr;
area = abs(estl) + abs(estr);
abarea = area + abarea - abs(est);
if (level != QuadMo_MaxLvl)
goto l200;
QuadMo_nlvlk[k] = QuadMo_nlvlk[k] + 1;
rombrg = estint;
goto l300;
l200:
if ((abs(est - estint) > (eps*abarea)) || (level < QuadMo_MinLvl))
goto l400;
rombrg = (16 * estint - est) / 15;
l300:
level = level - 1;
i = retrn[level];
valint[level][i] = rombrg;
if (i == 1)
goto l500;
if (i == 2)
goto l600;
l400:
retrn[level] = 1;
Middlex[level] = Middle;
Rightx[level] = Right;
fmx[level] = fMiddle;
fmrx[level] = fmr;
frx[level] = fRight;
estrx[level] = estr;
epsx[level] = eps;
eps = eps / 1.4;
Right = Middle;
fRight = fMiddle;
fMiddle = fml;
est = estl;
goto l100;
l500:
retrn[level] = 2;
Left = Middlex[level];
Right = Rightx[level];
fLeft = fmx[level];
fMiddle = fmrx[level];
fRight = frx[level];
est = estrx[level];
eps = epsx[level];
goto l100;
l600:
rombrg = valint[level][1] + valint[level][2];
if (level > 1)
goto l300;
ans = rombrg / 12.0;
return ans;
}
double funkn(double *thet)
{
//in this case a Gaussian centered at 0.5 with SD 0.1
double *sm;
double sum;
sm = new double[nDim];
sum = 0.0;
for (int i = 1; i <= nDim; i++)
{
sm[i] = (thet[i] - 0.5) / 0.1;
sm[i] *= sm[i];
sum = sum + sm[i];
}
return exp(-sum / 2.0);
}
int main() {
double ans;
printf("\nnDim ans expected nlvl\n");
for (nDim = 1; nDim <= 6; nDim++)
{
//expected answer is(0.1 sqrt(2pi))**nDim
QuadMo_nlvlk = new int[nDim + 1]; //array for x values
thet = new double[nDim + 1]; //array for x values
ans = MultInt(nDim);
printf("\n %d %f %f ", nDim, ans, pow((0.250663),nDim));
for (int j=1; j<=nDim; j++)
printf(" %d ", QuadMo_nlvlk[nDim]);
printf("\n");
}
return 0;
}
Declare relevant parameters globally
int QuadMo_MinLvl = 2;
int QuadMo_MaxLvl = 3;
double QuadMo_Tol = 0.1;
int *QuadMo_nlvlk;
double *thet;
int nDim;
This coding is much clearer than the obfuscated antiquated fortran coding, with some tweaking the integral limits and tolerances could be parameterised!!
There are better algorithms to use with adaptive techniques and which handle singularities on the surfaces etc....