Converting wind direction in angles to text words - angle

I have wind direction data coming from a weather vane, and the data is represented in 0 to 359 degrees.
I want to convert this into text format (compass rose) with 16 different directions.
Basically I want to know if there is a fast slick way to scale the angle reading to a 16 string array to print out the correct wind direction without using a bunch of if statements and checking for ranges of angles
Wind direction can be found here.
thanks!

EDIT :
Since there is an angle change at every 22.5 degrees, the direction should swap hands after 11.25 degrees.
Therefore:
349-360//0-11 = N
12-33 = NNE
34-56 = NE
Using values from 327-348 (The entire NNW spectrum) failed to produce a result for eudoxos' answer.
After giving it some thought I could not find the flaw in his logic, so i rewrote my own..
def degToCompass(num):
val=int((num/22.5)+.5)
arr=["N","NNE","NE","ENE","E","ESE", "SE", "SSE","S","SSW","SW","WSW","W","WNW","NW","NNW"]
print arr[(val % 16)]
>>> degToCompass(0)
N
>>> degToCompass(180)
S
>>> degToCompass(720)
N
>>> degToCompass(11)
N
>>> 12
12
>>> degToCompass(12)
NNE
>>> degToCompass(33)
NNE
>>> degToCompass(34)
NE
STEPS :
Divide the angle by 22.5 because 360deg/16 directions = 22.5deg/direction change.
Add .5 so that when you truncate the value you can break the 'tie' between the change threshold.
Truncate the value using integer division (so there is no rounding).
Directly index into the array and print the value (mod 16).

Here's a javascript implementation of steve-gregory's answer, which works for me.
function degToCompass(num) {
var val = Math.floor((num / 22.5) + 0.5);
var arr = ["N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW"];
return arr[(val % 16)];
}
See his answer for an explanation of the logic.

This JavaScript will work for anyone who only needs 8 cardinal directions and would like corresponding arrows.
function getCardinalDirection(angle) {
const directions = ['↑ N', '↗ NE', '→ E', '↘ SE', '↓ S', '↙ SW', '← W', '↖ NW'];
return directions[Math.round(angle / 45) % 8];
}

Watch out for rounding, angles between 349...11 should be "N", therefore add half sector first (+(360/16)/2), then handle overflow over 360 by %360, then divide by 360/16:
["N","NNW",...,"NNE"][((d+(360/16)/2)%360)/(360/16)]

I checked this and it works very good and seems accurate.
Source: http://www.themethodology.net/2013/12/how-to-convert-degrees-to-cardinal.html by Adrian Stevens
public static string DegreesToCardinal(double degrees)
{
string[] caridnals = { "N", "NE", "E", "SE", "S", "SW", "W", "NW", "N" };
return caridnals[(int)Math.Round(((double)degrees % 360) / 45)];
}
public static string DegreesToCardinalDetailed(double degrees)
{
degrees *= 10;
string[] caridnals = { "N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE", "S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW", "N" };
return caridnals[(int)Math.Round(((double)degrees % 3600) / 225)];
}

I believe it is easier to:
Shift the direction by 11.25
Add an "N" at the end of the direction list to handle the 'over 360',
DirTable = ["N","NNE","NE","ENE","E","ESE", "SE","SSE","S","SSW","SW","WSW", "W","WNW","NW","NNW",**"N"**];
wind_direction= DirTable[Math.floor((d+11.25)/22.5)];

If you arrived here and are only interested in breaking your degrees into one of 8 directions.
function degToCompass(num){
const val = Math.floor((num / 45) + 0.5);
const arr = ["N","NE","E", "SE","S","SW","W","NW"];
return arr[(val % 8)]

Here's a one-line python function:
def deg_to_text(deg):
return ["N","NNE","NE","ENE","E","ESE", "SE", "SSE","S","SSW","SW","WSW","W","WNW","NW","NNW"][round(deg/22.5)%16]
Obviously it can be split into multiple lines for readability/pep8

I would probably just do simple division of degrees to get a position in an array or an enum value or something that would give you the text you need. Just round down on all your division. 360/16 = 22.5, so you would want to divide by 22.5 to get the position.
String[] a = [N,NNW,NW,WNW,...,NNE]

this works fine
#!/usr/bin/env python
def wind_deg_to_str1(deg):
if deg >= 11.25 and deg < 33.75: return 'NNE'
elif deg >= 33.75 and deg < 56.25: return 'NE'
elif deg >= 56.25 and deg < 78.75: return 'ENE'
elif deg >= 78.75 and deg < 101.25: return 'E'
elif deg >= 101.25 and deg < 123.75: return 'ESE'
elif deg >= 123.75 and deg < 146.25: return 'SE'
elif deg >= 146.25 and deg < 168.75: return 'SSE'
elif deg >= 168.75 and deg < 191.25: return 'S'
elif deg >= 191.25 and deg < 213.75: return 'SSW'
elif deg >= 213.75 and deg < 236.25: return 'SW'
elif deg >= 236.25 and deg < 258.75: return 'WSW'
elif deg >= 258.75 and deg < 281.25: return 'W'
elif deg >= 281.25 and deg < 303.75: return 'WNW'
elif deg >= 303.75 and deg < 326.25: return 'NW'
elif deg >= 326.25 and deg < 348.75: return 'NNW'
else: return 'N'
def wind_deg_to_str2(deg):
arr = ['NNE', 'NE', 'ENE', 'E', 'ESE', 'SE', 'SSE', 'S', 'SSW', 'SW', 'WSW', 'W', 'WNW', 'NW', 'NNW', 'N']
return arr[int(abs((deg - 11.25) % 360)/ 22.5)]
i = 0
while i < 360:
s1 = wind_deg_to_str1(i)
s2 = wind_deg_to_str2(i)
print '%5.1f deg -> func1(%-3s), func2(%-3s), same:%s' % (i, s1, s2, ('ok' if s1 == s2 else 'different'))
i += 0.5

To do the reverse conversion (compass letter abbreviations to degrees):
function getDir($b)
{
$dirs = array('N'=>0, 'NNE'=>22.5,"NE"=>45,"ENE"=>67.5, 'E'=>90,'ESE'=>112.5, 'SE'=>135,'SSE'=>157.5, 'S'=>180,'SSW'=>202.5, 'SW'=>225,'WSW'=>247.5, 'W'=>270,'WNW'=>292.5,'NW'=>315,'NNW'=>337.5, 'N'=>0,'North'=>0,'East'=>90,'West'=>270,'South'=>180);
return $dirs[$b];
}

Javascript function 100% working
function degToCompass(num) {
while( num < 0 ) num += 360 ;
while( num >= 360 ) num -= 360 ;
val= Math.round( (num -11.25 ) / 22.5 ) ;
arr=["N","NNE","NE","ENE","E","ESE", "SE",
"SSE","S","SSW","SW","WSW","W","WNW","NW","NNW"] ;
return arr[ Math.abs(val) ] ;
}
steps
Given a 360 degree angle
Since north is between -11.25 to 11.25 we subtract 11.25 for accuracy
Divide the angle by 22.5 because 360deg/16 directions = 22.5deg/direction change
Math.abs for as negative is still north
Select the segment from arr from answer
Hope it helps

Used this in Excel:
VLOOKUP(MROUND(N12,22.5),N14:O29,2,FALSE)
Cell N12 is direction toward in degrees for which an answer is needed.
The range N14:O29 is looking up the sector(A to R):
WIND SECTOR
0 A
22.5 B
45 C
67.5 D
90 E
112.5 F
135 G
157.5 H
180 J
202.5 K
225 L
247.5 M
270 N
292.5 P
315 Q
337.5 R

I use R heavily and needed a solution for this. This is what I came up with and works well for all possible combinations I have fed it:
degToCardinal <- function(degrees) {
val <- as.integer((degrees / 22.5) + 0.5)
arr <- c("N","NNE","NE","ENE","E","ESE", "SE", "SSE","S","SSW","SW","WSW","W","WNW","NW","NNW")
return(arr[((val+1) %% 16)])
}

Wanted to use #eudoxos but needed to pull all the parts together:
def deg_to_compass(d):
return ["N", "NNE", "NE", "ENE", "E", "ESE", "SE", "SSE",
"S", "SSW", "SW", "WSW", "W", "WNW", "NW", "NNW"] [math.floor(((d+(360/16)/2)%360)/(360/16))]
Borrrowed #Hristo markow to check the results:
for i in range(0,360):
print (i,deg_to_compass(i) == wind_deg_to_str2(i))

compass_direction =["NNE","NE","ENE","E","ESE","SE","SSE","S","SSW","SW","WSW","W","WNW","NW","NNW","N"]
for i in range (0,365):
index = (int) ((((i / 11.25) - 1) /2) % 16)
print(f"Angle: {i:3}, Index: {index}, Compass: {compass_direction[index]}")

Related

Finding negative numbers in Python CSV file

I have a CSV file I'm reading with Northing and Easting values I'm trying to calculate the direction angle they are facing in... have things mostly sorted out(I think) at this point, but the final values are all coming up between 0 and 90 it seems even though I have the following code in there...
if (u_eastward >= 0) and (v_northward >= 0):
azimouth = azimouth
elif (u_eastward >= 0 and v_northward <= 0):
azimouth = 180 - azimouth
elif (u_eastward <= 0 and v_northward <= 0):
azimouth = azimouth + 180
elif (u_eastward <= 0 and v_northward >= 0):
azimouth = 360 - azimouth
Azimouth is being calculated in Excel as '=ATAN(D2/C2)' to find radians and then being recalculated to the angle by '=DEGREES(E2)' on the arc tangent value which I think is correct.
Would appreciate any help.
Wasn't properly converting my string to a float so everything was being seen as a positive value.

Triangle function on angles

I need a function that works on angles (degrees for the example, but it may be radians as well) with the following (it must be continuous, I only write down some key values to understand the behavior):
any_function(angle):
0-> 0.0
45-> 0.5
90-> 1.0
135-> 0.5
180-> 0.0
225->-0.5
270->-1.0
335->-0.5
360-> 0.0
This is a simple triangular wave.
Does anything already exist in some modules or do I need to create it on my own?
For example like this (quick and dirty):
def toTriangle(angle):
if angle < 90 and angle >= 0:
t = (angle/90.)
elif angle <= 180 and angle >= 90:
t = 2-(angle/90.)
elif angle <= 270 and angle >= 180:
t = -(3-(angle/90.))
else:
t = -(4-(angle/90.))
return t
Thanks DeepSpace for your suggestion but it doesn't work out of the box:
from scipy.signal import sawtooth
sawtooth(0)
Out[4]: array(-1.0)
Here's a less quick-n-dirty solution:
def toTriangle(angle):
import math
tr = 1-4*math.fabs(0.5-math.modf(0.25+0.5*angle%(2*math.pi)/math.pi)[0] )
return t
( http://mathworld.wolfram.com/TriangleWave.html )

How can I calculate the curvature of an extracted contour by opencv?

I did use the findcontours() method to extract contour from the image, but I have no idea how to calculate the curvature from a set of contour points. Can somebody help me? Thank you very much!
While the theory behind Gombat's answer is correct, there are some errors in the code as well as in the formulae (the denominator t+n-x should be t+n-t). I have made several changes:
use symmetric derivatives to get more precise locations of curvature maxima
allow to use a step size for derivative calculation (can be used to reduce noise from noisy contours)
works with closed contours
Fixes:
* return infinity as curvature if denominator is 0 (not 0)
* added square calculation in denominator
* correct checking for 0 divisor
std::vector<double> getCurvature(std::vector<cv::Point> const& vecContourPoints, int step)
{
std::vector< double > vecCurvature( vecContourPoints.size() );
if (vecContourPoints.size() < step)
return vecCurvature;
auto frontToBack = vecContourPoints.front() - vecContourPoints.back();
std::cout << CONTENT_OF(frontToBack) << std::endl;
bool isClosed = ((int)std::max(std::abs(frontToBack.x), std::abs(frontToBack.y))) <= 1;
cv::Point2f pplus, pminus;
cv::Point2f f1stDerivative, f2ndDerivative;
for (int i = 0; i < vecContourPoints.size(); i++ )
{
const cv::Point2f& pos = vecContourPoints[i];
int maxStep = step;
if (!isClosed)
{
maxStep = std::min(std::min(step, i), (int)vecContourPoints.size()-1-i);
if (maxStep == 0)
{
vecCurvature[i] = std::numeric_limits<double>::infinity();
continue;
}
}
int iminus = i-maxStep;
int iplus = i+maxStep;
pminus = vecContourPoints[iminus < 0 ? iminus + vecContourPoints.size() : iminus];
pplus = vecContourPoints[iplus > vecContourPoints.size() ? iplus - vecContourPoints.size() : iplus];
f1stDerivative.x = (pplus.x - pminus.x) / (iplus-iminus);
f1stDerivative.y = (pplus.y - pminus.y) / (iplus-iminus);
f2ndDerivative.x = (pplus.x - 2*pos.x + pminus.x) / ((iplus-iminus)/2*(iplus-iminus)/2);
f2ndDerivative.y = (pplus.y - 2*pos.y + pminus.y) / ((iplus-iminus)/2*(iplus-iminus)/2);
double curvature2D;
double divisor = f1stDerivative.x*f1stDerivative.x + f1stDerivative.y*f1stDerivative.y;
if ( std::abs(divisor) > 10e-8 )
{
curvature2D = std::abs(f2ndDerivative.y*f1stDerivative.x - f2ndDerivative.x*f1stDerivative.y) /
pow(divisor, 3.0/2.0 ) ;
}
else
{
curvature2D = std::numeric_limits<double>::infinity();
}
vecCurvature[i] = curvature2D;
}
return vecCurvature;
}
For me curvature is:
where t is the position inside the contour and x(t) resp. y(t) return the related x resp. y value. See here.
So, according to my definition of curvature, one can implement it this way:
std::vector< float > vecCurvature( vecContourPoints.size() );
cv::Point2f posOld, posOlder;
cv::Point2f f1stDerivative, f2ndDerivative;
for (size_t i = 0; i < vecContourPoints.size(); i++ )
{
const cv::Point2f& pos = vecContourPoints[i];
if ( i == 0 ){ posOld = posOlder = pos; }
f1stDerivative.x = pos.x - posOld.x;
f1stDerivative.y = pos.y - posOld.y;
f2ndDerivative.x = - pos.x + 2.0f * posOld.x - posOlder.x;
f2ndDerivative.y = - pos.y + 2.0f * posOld.y - posOlder.y;
float curvature2D = 0.0f;
if ( std::abs(f2ndDerivative.x) > 10e-4 && std::abs(f2ndDerivative.y) > 10e-4 )
{
curvature2D = sqrt( std::abs(
pow( f2ndDerivative.y*f1stDerivative.x - f2ndDerivative.x*f1stDerivative.y, 2.0f ) /
pow( f2ndDerivative.x + f2ndDerivative.y, 3.0 ) ) );
}
vecCurvature[i] = curvature2D;
posOlder = posOld;
posOld = pos;
}
It works on non-closed pointlists as well. For closed contours, you may would like to change the boundary behavior (for the first iterations).
UPDATE:
Explanation for the derivatives:
A derivative for a continuous 1 dimensional function f(t) is:
But we are in a discrete space and have two discrete functions f_x(t) and f_y(t) where the smallest step for t is one.
The second derivative is the derivative of the first derivative:
Using the approximation of the first derivative, it yields to:
There are other approximations for the derivatives, if you google it, you will find a lot.
Here's a python implementation mainly based on Philipp's C++ code. For those interested, more details on the derivation can be found in Chapter 10.4.2 of:
Klette & Rosenfeld, 2004: Digital Geometry
def getCurvature(contour,stride=1):
curvature=[]
assert stride<len(contour),"stride must be shorther than length of contour"
for i in range(len(contour)):
before=i-stride+len(contour) if i-stride<0 else i-stride
after=i+stride-len(contour) if i+stride>=len(contour) else i+stride
f1x,f1y=(contour[after]-contour[before])/stride
f2x,f2y=(contour[after]-2*contour[i]+contour[before])/stride**2
denominator=(f1x**2+f1y**2)**3+1e-11
curvature_at_i=np.sqrt(4*(f2y*f1x-f2x*f1y)**2/denominator) if denominator > 1e-12 else -1
curvature.append(curvature_at_i)
return curvature
EDIT:
you can use convexityDefects from openCV, here's a link
a code example to find fingers based in their contour (variable res) source
def calculateFingers(res,drawing): # -> finished bool, cnt: finger count
# convexity defect
hull = cv2.convexHull(res, returnPoints=False)
if len(hull) > 3:
defects = cv2.convexityDefects(res, hull)
if type(defects) != type(None): # avoid crashing. (BUG not found)
cnt = 0
for i in range(defects.shape[0]): # calculate the angle
s, e, f, d = defects[i][0]
start = tuple(res[s][0])
end = tuple(res[e][0])
far = tuple(res[f][0])
a = math.sqrt((end[0] - start[0]) ** 2 + (end[1] - start[1]) ** 2)
b = math.sqrt((far[0] - start[0]) ** 2 + (far[1] - start[1]) ** 2)
c = math.sqrt((end[0] - far[0]) ** 2 + (end[1] - far[1]) ** 2)
angle = math.acos((b ** 2 + c ** 2 - a ** 2) / (2 * b * c)) # cosine theorem
if angle <= math.pi / 2: # angle less than 90 degree, treat as fingers
cnt += 1
cv2.circle(drawing, far, 8, [211, 84, 0], -1)
return True, cnt
return False, 0
in my case, i used about the same function to estimate the bending of board while extracting the contour
OLD COMMENT:
i am currently working in about the same, great information in this post, i'll come back with a solution when i'll have it ready
from Jonasson's answer, Shouldn't be here a tuple on the right side too?, i believe it won't unpack:
f1x,f1y=(contour[after]-contour[before])/stride
f2x,f2y=(contour[after]-2*contour[i]+contour[before])/stride**2

Finding a "movement direction" (angle) of a point

I'm working on a pretty cool project where I'm collecting data about the movement of a cursor, but I've run into an issue where I think I could use some help. I am constantly reading in data about the x and y position of the cursor (along with other relevant data), and once the cursor exceeds a certain threshold in the y-dimension, I need to calculate the movement direction (angle). Let me illustrate with a figure I drew:
What tends to happen is that the cursor moves in a somewhat straight line, but then curves towards the end of the movement. I need to calculate theta, i.e., the angle of the blue vector with respect to the positive x-axis. The idea I came up with is to use the last 2 samples to largely determine what the movement direction is, otherwise if I use too many samples I would skew what the actual angle is. To give an extreme case let me follow up with another picture:
Here each dot represents a sample. Note that if I use BOTH dots, the real angle I want will be wrong (again, I need to find the direction the cursor was moving in last, which is the vector drawn at the end of the line). I dont expect this case to come up much, but was wondering if there would be a way to solve for it if it does.
Lastly, note that the these motions can occur in either the first or second quadrant, if that makes a difference.
I'd really appreciate any help here. I'm coding this in C++ but I think I could translate any answer. Thanks.
This should get you started http://jsfiddle.net/0ao9oa7a/
Get all of the recorded points
Filter out points that are close together (I use 5 pixels)
Find the angles of each consecutive pair of points (atan2)
Find the absolute differences between each consecutive pair of angles
Throw away all of the angles before the max difference
Average the remaining angles (average all point vectors then atan2 back into an angle)
Code
function process(points) {
if(points.length === 0) {
txt = "Not enough points\n" + txt;
return null;
}
// compress points, removing those that are too close together
var newPoints = [];
newPoints.push(points[0]);
for(var i = 1; i < points.length; i++) {
if(Math.sqrt(Math.pow(points[i].x - newPoints[newPoints.length - 1].x, 2) + Math.pow(points[i].y - newPoints[newPoints.length - 1].y, 2)) > 5) {
newPoints.push(points[i]);
}
}
points = newPoints;
if(points.length < 2) {
txt = "Not enough points\n" + txt;
return null;
}
// get all of the angles
var angles = [];
for(var i=0; i < points.length - 1; i++) {
var rad = Math.atan2(points[i + 1].y - points[i].y, points[i + 1].x - points[i].x);
angles[i] = rad;
txt += "x: " + (points[i].x|0) + " y: " + (points[i].y|0) + " x: " + (points[i+1].x|0) + " y: " + (points[i+1].y|0) + " [" + ((rad * 180 / Math.PI)|0) + "]" + "\n";
}
txt += "\n";
// get all of the diffs between angles
// save the index of the max diff
var absDiffs = [];
var maxDiff = -1;
var maxDiffAngleIndex = -1;
for(var i=0; i < points.length - 1; i++) {
var delta = Math.abs(angles[i] - angles[i + 1]);
if(delta >= maxDiff) {
maxDiff = delta;
maxDiffAngleIndex = i + 1;
}
}
if(maxDiffAngleIndex == -1) {
txt = "Angle: " + angles[0] + " : " + (angles[0] * 180 / Math.PI) + "\n" + txt;
return angles[0];
} else if(maxDiffAngleIndex == angles.length - 1) {
txt = "Angle: " + angles[angle.length - 1] + " : " + (angles[angles.length - 1] * 180 / Math.PI) + "\n" + txt;
return angles[angles.length - 1];
} else {
// find the average angle from the index to the end
var sumX = 0;
var sumY = 0;
for(var i = maxDiffAngleIndex; i < angles.length; i++) {
sumX += Math.cos(angles[i]);
sumY += Math.sin(angles[i]);
}
var avgX = sumX / (angles.length - maxDiffAngleIndex);
var avgY = sumY / (angles.length - maxDiffAngleIndex);
//
var avgAngle = Math.atan2(avgY, avgX);
txt = "Angle: " + avgAngle + " : " + (avgAngle * 180 / Math.PI) + "\n" + txt;
return avgAngle;
}
}
As I can see, the “movement direction” (angle) of a point would be the angular coefficient of two dots, one dot at the end of the vector and the other one at the begnning.
Cause we can only find the angle with two dots, so we can make a line, since the direction vector would be (B-A), where A and B are the points I already told you about.
We can calcule this using the formula of the angular coefficient of a line:
m = Tan θ = Δy / Δx
And that is simply:
Tan θ = (yB – yA) / (xB – xA)
Where θ is the “movement direction” (angle) and (x,y) are the coordinates of the points A and B.
Talking about the quadrant, you will only need to use the trigonometric circle to know the sinal of the value of Tan θ, so take a look at this image:
And of course, after you find the value of Tan θ, you will need to use it to find the arctan θ, and that will be your final answer.

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....