I have a task to solve equation system with FindRoot:
a*x+b*y^2-c*x^2=a-b, a*x^2+b*y^2+b*x-cy=b+c , where a = 10, b = 10, c = 6;
I'm very(!) new to Mathematica and have one day to get to know it.
Any comments on how to solve that equation will be much appreciated!
Thanks!
This starts searching for root at x = 0 and y = 0
eq = {a*x + b*y^2 - c*x^2 == a - b, a*x^2 + b*y^2 + b*x - c*y == b + c}
param = {a -> 10, b -> 10, c -> 6}
result = FindRoot[eq /. param, {x, 0}, {y, 0}]
This only gives you 1 of the two Real solutions. Solve will give you both (and even some solutions with Complex numbers). To test it:
eq /. param /. result
This returns (True, True) so you know you've found the correct root.
To find the solution graphically, use ContourPlot:
ContourPlot[Evaluate[eq /. param], {x, -5, 5}, {y, -5, 5}]
Here is the version with Solve/NSolve
NSolve[{a*x + b*y^2 - c*x^2 == a - b,
a*x^2 + b*y^2 + b*x - c*y == b + c} /. {a -> 10, b -> 10, c -> 6},
{x, y}]
It will give the 4 solutions. If you use Solve instead of NSolve you will have a (large) closed form of each component of each solution.
If you need more digits for the solution, add at the end of the NSolve command the option WorkingPrecision->30 (or any other number of digits. These are quadratics, they can computed to any precision necessary).
Related
I am trying to learn a little bit about Wolfram Mathematica.
I want to define a symbolic function
where x is a vector, g is a function that takes a vector and returns a vector and h is a function that takes a vector and returns a scalar.
I don't want to commit to specific g and h, I just want to have a symbolic representation for them.
I would like to get a symbolic form for the third order derivatives (which would be a tensor) -- is there a way to do that in Wolfram Mathematica?
EDIT: I should mention, A and C are matrices, and b and d are vectors.
Here is what I tried and didn't work:
Try this
f[x_] := x*E^x
and then this
f'[x]
returns this
E^x + E^x x
and this
f''[x]
returns this
2 E^x + E^x x
Three methods of notation, all producing the same result.
f[x_] := Sin[x] + x^2
D[f[x], x]
2 x + Cos[x]
f'[x]
2 x + Cos[x]
f''[x]
2 - Sin[x]
using an alternative form of definition of f
Clear[f]
f = Sin[x] + x^2
D[f, x]
2 x + Cos[x]
δx f
2 x + Cos[x]
δ{x,2} f
2 - Sin[x]
Note
δ{x,2} f is supposed to be the subscript form of D[f, {x, 2}] but web formatting is limited.
Scoping out matrix and vector dimensions, and using S instead of C since the latter is a protected (uppercase) symbol.
A = {{1, 2, 3}, {4, 5, 6}};
x = {2, 4, 8};
A.x
{34, 76}
b = {3, 5};
h = 3;
h (A.x + b)
{111, 243}
S = {{1, 2}, {3, 4}, {5, 6}};
S.(h (A.x + b))
{597, 1305, 2013}
d = {2, 4, 8};
g = 2;
g (S.(h (A.x + b)) + d)
{1198, 2618, 4042}
So compatible matrix and vector assumptions can be made. (It turns out the derivative result comes out the same without taking the trouble to make the assumptions.)
Clear[A, x, b, S, d]
$Assumptions = {
Element[A, Matrices[{m, n}]],
Element[x, Vectors[n]],
Element[b, Vectors[m]],
Element[S, Matrices[{n, m}]],
Element[d, Vectors[n]]};
f = g (S.(h (A.x + b)) + d);
D[f, x]
g S.(h A.1)
D[f, {x, 3}]
0
I'm not sure if these results are correct so if you find out do comment.
I'm very new to Mathematica, so sorry if this has an obvious answer, but:
I'm trying to use NSolve to find the point of intersection between two functions, one of which was made using Interpolation, but it won't give me a solution.
Here is the input:
data = Table[x, {x, 1, 25, 1}];
data2 = Table[x^.5, {x, 1, 25, 1}];
a1 = Interpolation[Transpose[{data, data2}]];
NSolve[a1[z] == 5 - z^.5, z]
And the output:
NSolve[InterpolatingFunction[][z] == 5 - z^0.5, z, Reals]
Thanks for the help!
In[1]:= data = Table[x, {x, 1, 25, 1}];
data2 = Table[x^.5, {x, 1, 25, 1}];
a1 = Interpolation[Transpose[{data, data2}]];
r = z /. FindRoot[a1[z] - (5 - z^.5), {z, 1}];
{r, a1[r], 5 - r^.5}
Out[5]= {6.24994, 2.50001, 2.50001}
I need to create a 3 by 3 real orthonormal symbolic matrix in Mathematica.
How can I do so?
Not that I recommend this, but...
m = Array[a, {3, 3}];
{q, r} = QRDecomposition[m];
q2 = Simplify[q /. Conjugate -> Identity]
So q2 is a symbolic orthogonal matrix (assuming we work over reals).
You seem to want some SO(3) group parametrization in Mathematica I think. You will only have 3 independent symbols (variables), since you have 6 constraints from mutual orthogonality of vectors and the norms equal to 1. One way is to construct independent rotations around the 3 axes, and multiply those matrices. Here is the (perhaps too complex) code to do that:
makeOrthogonalMatrix[p_Symbol, q_Symbol, t_Symbol] :=
Module[{permute, matrixGeneratingFunctions},
permute = Function[perm, Permute[Transpose[Permute[#, perm]], perm] &];
matrixGeneratingFunctions =
Function /# FoldList[
permute[#2][#1] &,
{{Cos[#], 0, Sin[#]}, {0, 1, 0}, {-Sin[#], 0, Cos[#]}},
{{2, 1, 3}, {3, 2, 1}}];
#1.#2.#3 & ## MapThread[Compose, {matrixGeneratingFunctions, {p, q, t}}]];
Here is how this works:
In[62]:= makeOrthogonalMatrix[x,y,z]
Out[62]=
{{Cos[x] Cos[z]+Sin[x] Sin[y] Sin[z],Cos[z] Sin[x] Sin[y]-Cos[x] Sin[z],Cos[y] Sin[x]},
{Cos[y] Sin[z],Cos[y] Cos[z],-Sin[y]},
{-Cos[z] Sin[x]+Cos[x] Sin[y] Sin[z],Cos[x] Cos[z] Sin[y]+Sin[x] Sin[z],Cos[x] Cos[y]}}
You can check that the matrix is orthonormal, by using Simplify over the various column (or row) dot products.
I have found a "direct" way to impose special orthogonality.
See below.
(*DEFINITION OF ORTHOGONALITY AND SELF ADJUNCTNESS CONDITIONS:*)
MinorMatrix[m_List?MatrixQ] := Map[Reverse, Minors[m], {0, 1}]
CofactorMatrix[m_List?MatrixQ] := MapIndexed[#1 (-1)^(Plus ## #2) &, MinorMatrix[m], {2}]
UpperTriangle[ m_List?MatrixQ] := {m[[1, 1 ;; 3]], {0, m[[2, 2]], m[[2, 3]]}, {0, 0, m[[3, 3]]}};
FlatUpperTriangle[m_List?MatrixQ] := Flatten[{m[[1, 1 ;; 3]], m[[2, 2 ;; 3]], m[[3, 3]]}];
Orthogonalityconditions[m_List?MatrixQ] := Thread[FlatUpperTriangle[m.Transpose[m]] == FlatUpperTriangle[IdentityMatrix[3]]];
Selfadjunctconditions[m_List?MatrixQ] := Thread[FlatUpperTriangle[CofactorMatrix[m]] == FlatUpperTriangle[Transpose[m]]];
SO3conditions[m_List?MatrixQ] := Flatten[{Selfadjunctconditions[m], Orthogonalityconditions[m]}];
(*Building of an SO(3) matrix*)
mat = Table[Subscript[m, i, j], {i, 3}, {j, 3}];
$Assumptions = SO3conditions[mat]
Then
Simplify[Det[mat]]
gives 1;...and
MatrixForm[Simplify[mat.Transpose[mat]]
gives the identity matrix;
...finally
MatrixForm[Simplify[CofactorMatrix[mat] - Transpose[mat]]]
gives a Zero matrix.
========================================================================
This is what I was looking for when I asked my question!
However, let me know your thought on this method.
Marcellus
Marcellus, you have to use some parametrization of SO(3), since your general matrix has to reflect the RP3 topology of the group. No single parametrization will cover the whole group without either multivaluedness or singular points. Wikipedia has a nice page about the various charts on SO(3).
Maybe one of the conceptually simplest is the exponential map from the Lie algebra so(3).
Define an antisymmetric, real A (which spans so(3))
A = {{0, a, -c},
{-a, 0, b},
{c, -b, 0}};
Then MatrixExp[A] is an element of SO(3).
We can check that this is so, using
Transpose[MatrixExp[A]].MatrixExp[A] == IdentityMatrix[3] // Simplify
If we write t^2 = a^2 + b^2 + c^2, we can simplify the matrix exponential down to
{{ b^2 + (a^2 + c^2) Cos[t] , b c (1 - Cos[t]) + a t Sin[t], a b (1 - Cos[t]) - c t Sin[t]},
{b c (1 - Cos[t]) - a t Sin[t], c^2 + (a^2 + b^2) Cos[t] , a c (1 - Cos[t]) + b t Sin[t]},
{a b (1 - Cos[t]) + c t Sin[t], a c (1 - Cos[t]) - b t Sin[t], a^2 + (b^2 + c^2) Cos[t]}} / t^2
Note that this is basically the same parametrization as RotationMatrix gives.
Compare with the output from
RotationMatrix[s, {b, c, a}] // ComplexExpand // Simplify[#, Trig -> False] &;
% /. a^2 + b^2 + c^2 -> 1
Although I really like the idea of Marcellus' answer to his own question, it's not completely correct. Unfortunately, the conditions he arrives at also result in
Simplify[Transpose[mat] - mat]
evaluating to a zero matrix! This is clearly not right. Here's an approach that's both correct and more direct:
OrthogonalityConditions[m_List?MatrixQ] := Thread[Flatten[m.Transpose[m]] == Flatten[IdentityMatrix[3]]];
SO3Conditions[m_List?MatrixQ] := Flatten[{OrthogonalityConditions[m], Det[m] == 1}];
i.e. multiplying a rotation matrix by its transpose results in the identity matrix, and the determinant of a rotation matrix is 1.
In Mathematica, calling Solve, returns a list of rules, e.g.,
In[1]:= g = Solve[(x - 1) (x - 2) == 0, x]
Out[1]= {{x -> 1}, {x -> 2}}
How can I extract the numerical values 1 or 2 from g?
I tried using Part e.g., g[[1]] but it returns {x -> 1} and not 1.
Please advise.
To complement Belisarius' answer,
x /. g
with g = {{x -> 1}, {x -> 2}}, returns the list
{1, 2}
So to extract the first value, 1, we could use
First[x /. g]
Other alternatives are
x /. g[[1]]
(x /. g)[[1]] (* this is equivalent to the version using First *)
g[[1,1,2]]
x /. g[[1]]
Filler -> Thirty chars minimum
I am wondering if anyone can help me to plot the Cantor dust on the plane in Mathematica. This is linked to the Cantor set.
Thanks a lot.
EDIT
I actually wanted to have something like this:
Here's a naive and probably not very optimized way of reproducing the graphics for the ternary Cantor set construction:
cantorRule = Line[{{a_, n_}, {b_, n_}}] :>
With[{d = b - a, np = n - .1},
{Line[{{a, np}, {a + d/3, np}}], Line[{{b - d/3, np}, {b, np}}]}]
Graphics[{CapForm["Butt"], Thickness[.05],
Flatten#NestList[#/.cantorRule&, Line[{{0., 0}, {1., 0}}], 6]}]
To make Cantor dust using the same replacement rules, we take the result at a particular level, e.g. 4:
dust4=Flatten#Nest[#/.cantorRule&,Line[{{0.,0},{1.,0}}],4]/.Line[{{a_,_},{b_,_}}]:>{a,b}
and take tuples of it
dust4 = Transpose /# Tuples[dust4, 2];
Then we just plot the rectangles
Graphics[Rectangle ### dust4]
Edit: Cantor dust + squares
Changed specs -> New, but similar, solution (still not optimized).
Set n to be a positive integer and choice any subset of 1,...,n then
n = 3; choice = {1, 3};
CanDChoice = c:CanD[__]/;Length[c]===n :> CanD[c[[choice]]];
splitRange = {a_, b_} :> With[{d = (b - a + 0.)/n},
CanD##NestList[# + d &, {a, a + d}, n - 1]];
cantLevToRect[lev_]:=Rectangle###(Transpose/#Tuples[{lev}/.CanD->Sequence,2])
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 4] // Rest;
Graphics[{FaceForm[LightGray], EdgeForm[Black],
Table[cantLevToRect[lev], {lev, Most#dust}],
FaceForm[Black], cantLevToRect[Last#dust /. CanDChoice]}]
Here's the graphics for
n = 7; choice = {1, 2, 4, 6, 7};
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 2] // Rest;
and everything else the same:
Once can use the following approach. Define cantor function:
cantorF[r:(0|1)] = r;
cantorF[r_Rational /; 0 < r < 1] :=
Module[{digs, scale}, {digs, scale} = RealDigits[r, 3];
If[! FreeQ[digs, 1],
digs = Append[TakeWhile[Most[digs]~Join~Last[digs], # != 1 &], 1];];
FromDigits[{digs, scale}, 2]]
Then form the dust by computing differences of F[n/3^k]-F[(n+1/2)/3^k]:
With[{k = 4},
Outer[Times, #, #] &[
Table[(cantorF[(n + 1/2)/3^k] - cantorF[(n)/3^k]), {n, 0,
3^k - 1}]]] // ArrayPlot
I like recursive functions, so
cantor[size_, n_][pt_] :=
With[{s = size/3, ct = cantor[size/3, n - 1]},
{ct[pt], ct[pt + {2 s, 0}], ct[pt + {0, 2 s}], ct[pt + {2 s, 2 s}]}
]
cantor[size_, 0][pt_] := Rectangle[pt, pt + {size, size}]
drawCantor[n_] := Graphics[cantor[1, n][{0, 0}]]
drawCantor[5]
Explanation: size is the edge length of the square the set fits into. pt is the {x,y} coordinates of it lower left corner.