I use MiniZinc compute a problem of optimization of shortest path problem based on hakank's model in http://www.hakank.org/minizinc
I input the distance matrix to a symmetric one such that the graph is bidirectional.
int: start = 2; % start node
int: end = 1; % end node
int: M = 999; % large number
array[1..n, 1..n] of 0..M: d = array2d(1..n,1..n,
[ M, 11, 8, 3, 8, 10, 2, 4, % 1-X
11, M, 3, 5, 1, 4, 8, 3, % 2-X
8, 3, M, 5, 7, 7, 11, 4, % 3-X
3, 5, 5, M, 9, 3, 10, 15, % 4-X
8, 6, 7, 9, M, 7, 12, 1, % 5-X
10, 4, 7, 3, 7, M, 6, 9, % 6-X
2, 8, 8, 10, 12, 9, M, 14, % 7-X
4, 3, 4, 15, 1, 9, 14, M % 8-X
]
);
% objective to minimize
var int: total_cost = sum(i in 1..n, j in 1..n where d[i,j] < M) ( d[i,j]*x[i,j] );
array[1..n] of var -1..1: rhs; % indicating start/end nodes
array[1..n, 1..n] of var 0..1: x; % the resulting connection matrix
array[1..n, 1..n] of var 0..n*n: y; % output node matrix
array[1..n] of var 0..1: outFlow; % out flow array
array[1..n] of var 0..1: inFlow; % in flow array
constraint
% set rhs for start/end nodes
forall(i in 1..n) (
if i = start then
rhs[i] = 1
elseif i = end then
rhs[i] = -1
else
rhs[i] = 0
endif
)
/\ % assert that all x values is >= 0
forall(i in 1..n, j in 1..n where d[i,j] < M) (
x[i,j] >= 0 /\ y[i,j] >= 0
)
/\ % calculate out flow
forall(i in 1..n) (
outFlow[i] = sum(j in 1..n where d[i,j] < M) (x[i,j])
)
/\ % calculate in flow
forall(j in 1..n) (
inFlow[j] = sum(i in 1..n where d[i,j] < M) (x[i,j])
)
/\ % outflow = inflow
forall(i in 1..n) (outFlow[i] - inFlow[i] = rhs[i])
/\ % do not loops
forall(i in 1..n) (
x[i,i] = 0
)
/\ % sanity: there can be no connection in x if there is not
% connection in d
forall(i,j in 1..n) (
if d[i,j] = M then
x[i,j] = 0
else
true
endif
)
;
solve minimize total_cost;
output [
if i = 1 /\ j = 1 then
"total_cost: " ++ show(total_cost) ++ "\n" ++
"inFlow: " ++ show(inFlow) ++ "\n" ++ "outFlow: " ++ show(outFlow) ++ "\n" ++
" 1 2 3 4 5 6 7 8\n"
else "" endif ++
if j = 1 then show(i) ++ " : " else "" endif ++
show_int(4,x[i,j]) ++ if j = n then "\n" else " " endif
| i in 1..n, j in 1..n
];
The solution gives an output matrix that indicates which edge of a graph is participating in the solution; however, the solution is directionless. I cannot tell the order of edge to take on a particular solution. In the above example, the shortest path from node 2 to node 1 gives the following solution
total_cost: 6
inFlow: [1, 0, 0, 0, 1, 0, 0, 1]
outFlow: [0, 1, 0, 0, 1, 0, 0, 1]
1 2 3 4 5 6 7 8
1 : 0 0 0 0 0 0 0 0
2 : 0 0 0 0 1 0 0 0
3 : 0 0 0 0 0 0 0 0
4 : 0 0 0 0 0 0 0 0
5 : 0 0 0 0 0 0 0 1
6 : 0 0 0 0 0 0 0 0
7 : 0 0 0 0 0 0 0 0
8 : 1 0 0 0 0 0 0 0
which suggests to the edge 8->1, 2->5, 5->8 are taken but I won't be able to order all edges as 2->5, 5->8, and 8->1.
I was thinking to find the index at where the start node is (here it is 2,5) and search the matrix until x[i,j]>0 and x[j,k]>0 where inFlow[j]=outFlow[j]=1, but it does not work since there may have more than one k satisfying the problem (the output graph is directionless). I wonder if there is any idea how to save the order of edges in solution. Thanks.
One way would be over a variable representing the path:
array[1..n] of var 0..n: path;
Define the path through constraints:
constraint
% start point
path[1] = start
/\ % end point
path[sum(inFlow) + 1] = end
/\ % interior points
forall(p in 2..sum(inFlow))
(path[p] = sum(i in 1..n)(i * x[path[p-1], i]));
Then show the path as part of the output statement:
"path: " ++ show([path[i] | i in 1..sum(inFlow) + 1]) ++ "\n" ++
Help me please!
On the 3-rd step I got such errors as
Part 41 of ...... does not exist.
though on the previous steps it worked and returned results.
I've got lists of 40 elements in spkn,spkw,spmn,spmw and 41 in spx,spfn,spfw.
Code:
spx = {-2, -1.90577, -1.81153, -1.59327, -1.375, -1.35785, -1.3407, -1.24655, -1.22941, -1.11811, -0.934054, -0.80167, -0.75, -0.625,-0.5, -0.25, -0.0981238, 0.303752, 0.651876, 0.94833, 1, 1.5, 1.75,2.11731, 2.5, 2.5625, 2.625, 3.3125, 3.75, 4, 4.00964, 4.01928,4.25964, 4.36731, 4.5, 4.75, 5, 5.25, 5.5, 5.75, 6}
spkw = {105.056, 89.2249, 17.7361, 7.25929, 7.25929, 7.25929, 7.25929,1.09386, 1.09386, -7.35382, -12.5073, -11.929, -11.929, -15.429, -8.63312,-6.34314, -14.3807, -16.7907, -18.933, -12.3896, -3.021, -22.0262,-25.7865, -18.8033, -9.07591, -9.18036, -8.49959, -9.24378, -7.32337,-0.271835, -0.270096, 0.123206, 0.156523, 0.465142, 4.12922, 4.23318,8.03654, 8.20981, 12.1518, 12.3944}
spkn = {73.5426, 66.8007, 24.6942, 16.4029, 0.726929,0.314512, -1.23002, -1.23002, -3.90668, -10.8276, -14.2065,-13.0895, -18.656, -20.1709, -8.79676, -8.79676, -11.2319, -13.9771, -15.1407, -2.50312, -4.72374, -32.4496, -34.2958, -21.0455, -2.45882,-2.45882, -2.45882, -2.45882, -2.45882, -2.45882, -2.45882, -1.70357, -1.70357, -1.11799, 6.1251, 6.36752, 6.36752, 6.60995, 14.0955,14.5803}
spmw = {243.475, 213.305, 83.8004, 67.1081, 67.1081, 67.1081, 67.1081,59.4226, 59.4226, 49.9772, 45.1635, 45.6272, 45.6272, 43.4397,46.8376, 47.4101, 46.6214, 47.3535, 48.75, 42.5447, 33.1761,61.6839, 68.2644, 53.4787, 29.1603, 29.4279, 27.6409,30.1061,22.9045,-5.30161,-5.30859,-6.88938,-7.0313,-8.37913,-24.8675,-25.3613, -44.3781, -45.2877, -66.9686, -68.3634}
spmn = {180.448, 167.6, 91.3225, 78.1123, 56.5579, 55.9978, 53.9271,53.9271, 50.6364, 42.898, 39.742, 40.6374, 36.4626, 35.5158,41.2028, 41.2028, 40.9639, 41.7978, 42.5563, 30.5716, 32.7923,74.3811, 77.6119, 49.5569, 3.09017, 3.09017, 3.09017, 3.09017,3.09017, 3.09017, 3.09017, 0.0546329, 0.0546329, -2.5028,-35.0967, -36.2482, -36.2482, -37.5209,-78.6912, -81.4791}
spfn[[i]] = spkn[[i]]*spx[[i]] + spmn[[i]];
spfw[[i]] = spkw[[i]]*spx[[i]] + spmw[[i]];
spfw = {33.3632, 43.263, 51.6709, 55.5421, 57.1266, 57.2511, 57.3756,58.059, 58.0778, 58.1995, 56.846, 55.1903, 54.5739, 53.0828,51.1542, 48.9959, 48.0325, 42.2533, 36.408,30.7952,30.1551,28.6446,23.138,19.4168,6.47053,5.90328,5.32951, -0.513959, -0.750527, -6.38895, -6.39157, -6.39418,-6.36456, -6.09357, -6.28599, -5.25369, -4.19539, -2.18625, -0.133803,2.90414, 6.171}
spfn = {33.3632, 40.2933, 46.5882, 51.9781, 55.5583, 55.5708, 55.5762,55.4604, 55.4393, 55.0045, 530116,51.1309,50.4546,48.1226,45.6012,43.402,42.066,37.5522, 32.6864, 28.1979, 28.0685,25.7067, 17.5943,13.5547, -2.97428, -3.21054,-3.36422, -5.05466, -5.1301, -6.4392,-6.76879, -6.48231, -7.20196, -7.00719, -7.53373, -6.00246, -4.41058,-2.8187, -1.16621, 2.35765, 6.04694}
1-st step:
For[i = 1, i < Length#spfn, i++,
If[spfn[[i]]*spfn[[i + 1]] < 0 && spfw[[i]]*spfw[[i + 1]] < 0,
Print["1) exist roots: ", xnz[i] = -spmn[[i]]/spkn[[i]], ", ",
xwz[i] = -spmw[[i]]/spkw[[i]]] ;
Break[]
]
]
2-nd step:
For[i = 1, i < Length#spfn, i++,
If[(0 < spfn[[i]]) && (spfn[[i + 1]] < 0) && (0 < spfw[[i]]) && (0 <
spfw[[i + 1]]),
Print["2) exist roots:", xnz[i] = -spmn[[i]]/spkn[[i]], ", ",
spx[[i + 1]]] ;
Break[]
]
]
3-rd step(DOESN'T WORK):
For[i = 1, i < Length#spfn, i++,
If[(spfn[[i]] < 0) && (0 < spfn[[i + 1]]) && (0 < spfw[[i]]) && (0 <
spfw[[i + 1]]),
Print["3) exist roots:", xnz[i] = -spmn[[i]]/spkn[[i]], ", ",
spx[[i]]];
Break[]
]
]
THE RESULTS are:
1) exist roots: 5.58272, 5.511
2) exist roots:2.35475, 2.5
and errors:
Part::partw: Part 41 of {73.5426,66.8007,24.6942,16.4029,0.726929,0.314512,-1.23002,-1.23002,-3.90668,-10.8276,-14.2065,-13.0895,-18.656,-20.1709,-8.79676,-8.79676,<<8>>,-2.45882,-2.45882,-2.45882,-2.45882,-2.45882,-2.45882,-2.45882,-1.70357,-1.70357,-1.11799,6.1251,6.36752,6.36752,6.60995,14.0955,14.5803} does not exist. >>
Part::partw: Part 41 of {-2,-1.90577,-1.81153,-1.59327,-1.375,-1.35785,-1.3407,-1.24655,-1.22941,-1.11811,-0.934054,-0.80167,-0.75,-0.625,-0.5,-0.25,-0.0981238,0.303752,0.651876,0.94833,1,1.5,1.75,2.11731,2.5,2.5625,2.625,3.3125,3.75,4,4.00964,4.01928,4.25964,4.36731,4.5,4.75,5,5.25,5.5,5.75,6} does not exist. >>
and some more similar..
If you take the following out of your 'Code' section the rest executes without error messages.
spfn[[i]] = spkn[[i]]*spx[[i]] + spmn[[i]];
spfw[[i]] = spkw[[i]]*spx[[i]] + spmw[[i]];
i want to translate my C++ code to wolfram, to improve my calcs.
C++ code
for(int i = 0; i < N - 1; ++i){
matrix[i][i] += L / 3 * uCoef - duCoef / 2 - (double)du2Coef/L;
matrix[i][i+1] += L / 6 * uCoef + duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i] += L / 6 * uCoef - duCoef / 2 + (double)du2Coef/L;
matrix[i+1][i+1] += L / 3 * uCoef + duCoef / 2- (double)du2Coef/L;
}
all this coef are const, N - size of my matrix.
In[1]:= n = 4; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = Table[0, {n}, {n}];
For[i = 1, i < n, ++i,
matrix[[i, i]] += L/3*uCoef - duCoef/2 - du2Coef/L;
matrix[[i, i+1]] += L/6*uCoef - duCoef/2 - du2Coef/L;
matrix[[i+1, i]] += L/6*uCoef + duCoef/2 + du2Coef/L;
matrix[[i+1, i+1]] += L/3*uCoef - duCoef/2 + du2Coef/L];
matrix
Out[4]= {
{5.19697, 1.5303, 0, 0},
{5.80303, 11.6667, 1.5303, 0},
{0, 5.80303, 11.6667, 1.5303},
{0, 0, 5.80303, 6.4697}}
Each character that has been changed from your original is hinting there is a fundamental difference between C++ and Mathematica
You should use SparseArray for such banded arrays in mathematica:
n = 5; uCoef = 2; duCoef = 3; du2Coef = 7; L = 11.;
matrix = SparseArray[
{{1, 1} -> L/3*uCoef - duCoef/2 - du2Coef/L,
{i_ /; 1 < i < n, i_} -> -duCoef + 2 L uCoef/3 ,
{n, n} -> ( L/3 uCoef - duCoef/2 + du2Coef/L ),
Band[{1, 2}] -> L/6 uCoef - duCoef/2 - du2Coef/L,
Band[{2, 1}] -> L/6 uCoef + duCoef/2 + du2Coef/L}, {n, n}];
MatrixForm#matrix
Even if you insist on the For loop, initialize the matrix as :
matrix = SparseArray[{{_, _} -> 0}, {n, n}];