Creating a matrix from the coefficients of equations - wolfram-mathematica

Given the equations
eqn1 = 5 x1 + 2 x2 + 3 x3 == 8
eqn2 = 4 x1 + 7 x2 + 9 x3 == 5
eqn3 = 6 x1 + x2 + 9 x3 == 2
how do I extract the coefficients of x1, x2, x3 to form a matrix?
I tried using CoefficientArrays but the output was given as a SparseArray.

Try Normal
(Normal[CoefficientArrays[{eqn1, eqn2, eqn3}, {x1, x2, x3}]][[2]]) // MatrixForm

I am not fond of Normal
Coefficient[# /. Equal[e_, _] -> e, {x1, x2, x3}] & /# {eqn1, eqn2, eqn3}
Shorter but not as clear:
Coefficient[First##, {x1, x2, x3}] & /# {eqn1, eqn2, eqn3}

Related

Define predicate from following the rules Prolog

I'm new to Prolog and I would like to convert given rules to Prolog language.
I have to define a predicate p(X1, Y1, X2, Y2) ,where X1, Y1 are integers, and X2 and Y2 are obtained from X1, Y1 following these rules:
if Y1 ≤ 0 and |X1|≤−Y1 then X2 is X1 + 1 and Y2 is Y1
else if X1 > 0 and |Y1| < X1 then X2 is X1, and Y2 is Y1+1
else if Y1 > 0 and −Y1 < X1 ≤ Y1 then X2 is X1−1, and Y2 is Y1
else X2 is X1 and Y2 is Y1−1
I'll provide a steer, here is rule 1:
p(X1, Y1, X2, Y2) :-
Y1 =< 0,
abs(X1) =< -Y1,
% Cut, to prevent processing alternatives
!,
X2 is X1 + 1,
Y2 is Y1.
Sample output in swi-prolog:
?- p(-3, -5, X2, Y2).
X2 = -2,
Y2 = -5.

Flattened form in WAM

The WAM: A Tutorial Reconstruction states that a query, p(Z, h(Z,W), f(W)), needs to be flattened using the following principles:
That being said, the query flattened form is:
X3=h(X2, X5), X4=f(X5), X1=p(X2, X3, X4);
I am lost with the definition of external variable, consider the following:
p(Z, h(Y, a(K, C), b(W)), f(W)).
Is Y an external variable? How should be the flattened form for this? From my understanding this would be the construction:
X1 = p(X2, X3, X4)
X2 = Z
X3 = h(X5, X6, X7)
X4 = f(X8)
X5 = Y
X6 = a(X7, X8)
X7 = K
X8 = C
X9 = b(X5)
But I am not sure, starting at X4 I got confused, should I have assigned the h inner values first?
You have the order the wrong way around: You are building terms before you have built their arguments. The text says to build the arguments before you build the outer terms. For example, you must build a(K, C) before you can build h(..., a(K, C), ...), and you must build that before you can build p(..., h(..., a(K, C), ...), ...). Here is one legal order:
X7 = K
X8 = C
X6 = a(X7, X8)
X5 = Y
X9 = b(X5)
X2 = Z
X3 = h(X5, X6, X7)
X4 = f(X8)
X1 = p(X2, X3, X4)

Creating random coefficients for linear equations in mathematica

Is there a way to assign a random value to p1, p2, p3 and p4 for the following equation?
p1 y1 + p2 y2 + p3 y3 = p4
given that y1, y2 and y3 are variables to be solved.
The easiest(?) way is to Thread a list of random values over a replacement rule:
For example:
p1 y1 + p2 y2 + p3 y3 == p4 /. Thread[{p1, p2, p3, p4} -> RandomReal[{0, 1}, 4]]
(* 0.345963 y1 + 0.333069 y2 + 0.565556 y3 == 0.643419 *)
Or, inspired by Leonid, you can use Alternatives and pattern matching:
p1 y1 + p2 y2 + p3 y3 == p4 /. p1 | p2 | p3 | p4 :> RandomReal[]
Just for fun, here's one more, similar solution:
p1 y1 + p2 y2 + p3 y3 == p4 /. s_Symbol :>
RandomReal[]/;StringMatchQ[SymbolName[s], "p"~~DigitCharacter]
Where you could replace DigitCharacter with NumberString if you want it to match more than just p0, p1, ..., p9. Of course, for large expressions, the above won't be particularly efficient...
The other answers are good, but if you do a lot of this sort of thing, I recommend naming your variables and coefficients in a more systematic way. This will not only allow you to write a much simpler rule, it will also make for much simpler changes when it's time to go from 3 equations to 4. For example:
In[1]:= vars = Array[y, 3]
Out[1]= {y[1], y[2], y[3]}
In[2]:= coeffs = Array[p, 4]
Out[2]= {p[1], p[2], p[3], p[4]}
You can be a little fancy when you make your equation:
In[3]:= vars . Most[coeffs] == Last[coeffs]
Out[3]= p[1] y[1] + p[2] y[2] + p[3] y[3] == p[4]
Substituting random numbers for the coefficients is now one one very basic rule:
In[4]:= sub = eqn /. p[_] :> RandomReal[]
Out[4]= 0.281517 y[1] + 0.089162 y[2] + 0.0860836 y[3] == 0.915208
The rule at the end could also be written _p :> RandomReal[], if you prefer. You don't have to type much to solve it, either.
In[5]:= Reduce[sub]
Out[5]= y[1] == 3.25099 - 0.31672 y[2] - 0.305785 y[3]
As Andrew Walker said, you use Reduce to find all the solutions, instead of just some of them. You can wrap this up in a function which paramerizes the number of variables like so:
In[6]:= reduceRandomEquation[n_Integer] :=
With[{vars = Array[y, n], coeffs = Array[p, n+1]},
Reduce[vars . Most[coeffs]]
In[7]:= reduceRandomEquation[4]
Out[7]= y[1] == 2.13547 - 0.532422 y[2] - 0.124029 y[3] - 2.48944 y[4]
If you need solutions with values substituted in, one possible way to do this is:
f[y1_, y2_, y3_] := p1 y1 + p2 y2 + p3 y3 - p4
g = f[y1, y2, y3] /. p1 -> RandomReal[] /. p2 -> RandomReal[] /.
p3 -> RandomReal[] /. p4 -> RandomReal[]
Reduce[g == 0, {y1}]
Reduce[g == 0, {y2}]
Reduce[g == 0, {y3}]
If all you need is the solution to the equations:
f[y1_, y2_, y3_] := p1 y1 + p2 y2 + p3 y3 - p4
g = f[y1, y2, y3]
Solve[g == 0, {y1}]
Solve[g == 0, {y2}]
Solve[g == 0, {y3}]
If you can live without the symbolic coefficient names p1 et al, then you might generate as below. We take a variable list, and number of equations, and a range for the coefficients and rhs vector.
In[80]:= randomLinearEquations[vars_, n_, crange_] :=
Thread[RandomReal[crange, {n, Length[vars]}].vars ==
RandomReal[crange, n]]
In[81]:= randomLinearEquations[{x, y, z}, 2, {-10, 10}]
Out[81]= {7.72377 x - 4.18397 y - 4.58168 z == -7.78991, -1.13697 x +
5.67126 y + 7.47534 z == -6.11561}
It is straightforward to obtain variants such as integer coefficients, different ranges for matrix and rhs, etc.
Daniel Lichtblau
Another way:
dim = 3;
eq = Array[p, dim].Array[y, dim] == p[dim + 1];
Evaluate#Array[p, dim + 1] = RandomInteger[10, dim + 1]
Solve[eq, Array[y, dim]]

How can I plot a function defined on the unit simplex in Mathematica?

I am trying to plot a function in Mathematica that is defined over the unit simplex. To take a random example, suppose I want to plot sin(x1*x2*x3) over all x1, x2, x3 such that x1, x2, x3 >= 0 and x1 + x2 + x3 = 1.
Is there a neat way of doing so, other than the obvious way of writing something like
Plot3D[If[x+y<=1,Sin[x y(1-x-y)]],{x,0,1},{y,0,1}]
?
What I want, ideally, is a way of plotting only over the simplex. I found the website http://octavia.zoology.washington.edu/Mathematica/ which has an old package, but it doesn't work on my up-to-date version of Mathematica.
If you want to get symmetric looking plots like in that package you linked, you need to figure out rotation matrix that puts the simplex into x/y plane. You can use this function below. It's kind of long because I left in the calculations to figure out simplex centering. Ironically, transformation for 4d simplex plot is much simpler. Modify e variable to get different margin
simplexPlot[func_, plotFunc_] :=
Module[{A, B, p2r, r2p, p1, p2, p3, e, x1, x2, w, h, marg, y1, y2,
valid},
A = Sqrt[2/3] {Cos[#], Sin[#], Sqrt[1/2]} & /#
Table[Pi/2 + 2 Pi/3 + 2 k Pi/3, {k, 0, 2}] // Transpose;
B = Inverse[A];
(* map 3d probability vector into 2d vector *)
p2r[{x_, y_, z_}] := Most[A.{x, y, z}];
(* map 2d vector in 3d probability vector *)
r2p[{u_, v_}] := B.{u, v, Sqrt[1/3]};
(* Bounds to center the simplex *)
{p1, p2, p3} = Transpose[A];
(* extra padding to use *)
e = 1/20;
x1 = First[p1] - e/2;
x2 = First[p2] + e/2;
w = x2 - x1;
h = p3[[2]] - p2[[2]];
marg = (w - h + e)/2;
y1 = p2[[2]] - marg;
y2 = p3[[2]] + marg;
valid =
Function[{x, y}, Min[r2p[{x, y}]] >= 0 && Max[r2p[{x, y}]] <= 1];
plotFunc[func ## r2p[{x, y}], {x, x1, x2}, {y, y1, y2},
RegionFunction -> valid]
]
Here's how to use it
simplexPlot[Sin[#1 #2 #3] &, Plot3D]
(source: yaroslavvb.com)
simplexPlot[Sin[#1 #2 #3] &, DensityPlot]
(source: yaroslavvb.com)
If you want to see domain in the original coordinate system, you could rotate the plot back to the simplex
t = AffineTransform[{{{-(1/Sqrt[2]), -(1/Sqrt[6]), 1/Sqrt[3]}, {1/
Sqrt[2], -(1/Sqrt[6]), 1/Sqrt[3]}, {0, Sqrt[2/3], 1/Sqrt[
3]}}, {1/3, 1/3, 1/3}}];
graphics = simplexPlot[5 Sin[#1 #2 #3] &, Plot3D];
shape = Cases[graphics, _GraphicsComplex];
Graphics3D[{Opacity[.5], GeometricTransformation[shape, t]},
Axes -> True]
(source: yaroslavvb.com)
Here's another simplex plot, using traditional 3d axes from here and MeshFunctions->{#3&}, complete code here
(source: yaroslavvb.com)
Try:
Plot3D[Sin[x y (1 - x - y)], {x, 0, 1}, {y, 0, 1 - x}]
But you can also use Piecewise and RegionFunction:
Plot3D[Piecewise[{{Sin[x y (1 - x - y)],
x >= 0 && y >= 0 && x + y <= 1}}], {x, 0, 1}, {y, 0, 1},
RegionFunction -> Function[{x, y}, x + y <= 1]]

How to generate a list of sets of inequalities in mathematica

I want to do the following in Mma. Suppose I have three expressions, x1, 3 x1-x2, x2-x1 where 0<=x1,x2<=1). I want to have another one which specifies the largest among the three is at least twice of the smallest. So there are some permutation of the three in terms of their order:
x1<=3 x1-x2<=x2-x1 && 2 x1<=x2-x1
3 x1-x2<=x1<=x2-x1 && 2 (3 x1-x2)<=x2-x1
....
with the rest 4 similar conditions.
How do I form these conditions automatically (together with 0<=x1,x2<=1), and then feed them into Reduce one-by-one, and solve for x2 in terms of x1?
Many thanks!
eqs = {x1, 3 x1 - x2, x2 - x1};
Reduce[Max[eqs] >= 2 Min[eqs], {x1, x2}, Reals]
If you want to do comparisons with second-largest or third largest/smallest then can use RankedMax
As far as solving it for x2 -- there are many different values of x2 corresponding to each x1 so you can't solve it in the conventional sense, you can see it from RegionPlot
RegionPlot[Max[eqs] >= 2 Min[eqs], {x1, 0, 1}, {x2, 0, 1}, PlotPoints -> 100]
Use Max and Min and specify x2 before x1 in the variable list, as follows
In[1]:= Reduce[
Max[x1, 3 x1 - x2, x2 - x1] >= 2 Min[x1, 3 x1 - x2, x2 - x1] &&
0 <= x1 && x2 <= 1,
{x2, x1}]

Resources