12
Here is a simple implementation:
Protect[qCO, qDO];
qOperatorQ[expr_] := MatchQ[expr, qCO | qDO | Ket[n_Integer]];
(* take scalars out *)
CenterDot[left___, Times[scalar_?NumericQ, op_?qOperatorQ], right___] := Times[
scalar,
CenterDot[left, op, right]
];
(* Implement commutation relations *)
CenterDot[left___, qDO, qCO, right___] := Plus[
...
11
There are different ways to go about doing this. I'll set UpValues on e for the multiplication of the basis vectors as you've defined them, and I'll use replacement Rules for the simplification of products of vectors expanded in the basis.
First of all
Unprotect[e]
ClearAll@e
e /: NonCommutativeMultiply[e[i_], e[j_]] /; i < j := -NonCommutativeMultiply[...
10
For moduli that are square-free one can use Chinese remaindering on the
coefficient lists to get a result valid for the moduli product.
cfs[p1_, p2_, x_, p_] :=
Reverse[CoefficientList[PolynomialGCD[p1, p2, Modulus -> p], x,
1 + Min[Exponent[p1, x], Exponent[p2, x]]]]
FromDigits[
ChineseRemainder[
Transpose[{cfs[f[x], g[x], x, 7], cfs[f[x], g[x]...
10
The function NonCommutativeMultiply has too long of a name, so I make a short-hand version of it (NCP stands for non-commutative product):
NCP[x___] := NonCommutativeMultiply[x];
Now, here's the code
NCP[] := 1
NCP[left___, a, a†, right___] := NCP[left, a†, a, right] + NCP[left, right]
NCP[left___, b, b†, right___] := NCP[left, b†, b, right] + NCP[left, ...
10
I decided it was worth giving another example of modern OOP in Mathematica. There will be a small amount of code, but almost all of it is boiler-plate. I use a package to handle most of the boiler plater, myself, but I find that links to packages make the code less-likely to be used.
So here we go.
First off, we'll define a constructor for your Algebra ...
9
You can use ComplexityFunction option to "penalize" the number of terms with a negative sign:
cf = (LeafCount[#] + 100 Count[#, _?Internal`SyntacticNegativeQ, ∞] &);
Simplify[(-2*x^2*(-1 + x^2))/135, ComplexityFunction -> cf]
2/135 x^2 (1 - x^2)
As chris noted in comments, this gives an unsatisfactory result for the following example:
...
8
You get get far by just implementing the linearity rules for the commutator (and that 0 and 1 "escape" the matrix product. The first two aren't strictly needed, but I include them for completeness:
commutator[Plus[a_,A__],B_]:=commutator[a,B]+commutator[Plus[A],B]
commutator[A_,Plus[b_,B__]]:=commutator[A,b]+commutator[A,Plus[B]]
commutator[A_**B_,C_]:=A**...
8
I upvoted the other responses. That said, there is a better way.
CoefficientList[
Resultant[x^3 + a2*x^2 + a1*x + a0, y - (x^3 + x + 1), x], y]
(* Out[1179]= {-1 + 4 a0 - 3 a0^2 + a0^3 - a1 - 2 a0 a1 + 2 a1^2 +
a0 a1^2 - a1^3 + a2 + a0 a2 - 2 a0^2 a2 - 3 a1 a2 + 3 a0 a1 a2 +
a0 a2^2 - a1 a2^2 + a2^3,
3 - 6 a0 + 3 a0^2 + a1 - 2 a1^2 + a1^3 - 2 a2 - ...
8
Use PiecewiseExpand
R[a_, b_] := KroneckerDelta[a, b] KroneckerDelta[a, b] // PiecewiseExpand
R[a, b]
R[a_, b_] := Product[KroneckerDelta[a, b] , {n, 5}] // PiecewiseExpand
R[a, b]
R[a_, b_] :=
Product[KroneckerDelta[a, b] , {n, m}] // PiecewiseExpand[#, m > 1] &
R[a, b]
8
Something like this?
(F1/F2 /. c/f -> Defer[c/f]) /. aa_*bb_Defer -> Defer[aa]*bb
(* Out[15]= c/f (d e)/(g h i k) *)
Reordering will require a different operator e.g NonCommutativeMultiply on the rhs of the second replacement rule, and then some further formatting to make it look like ordinary multiplication.
--- edit ---
Except formatting ...
8
Edit. Based on the comments, here is a more concrete answer to what I think you'd like. My previous answer can be found below.
Defining a ring symbolically. Let's consider some ring (or algebra) generated by symbols $g_i^\pm$ for $1\leq i\leq n$. Actually I'm not going to specify $n$ in the following as I don't think there's any need for it.
First of all ...
8
You can use a variation of the idea I gave here:
Normal @ Series[
ss /. {f:u1|u2 -> (s f[#1,#2,#3,#4]&)},
{s, 0, 3}
] /. s->1
u2[x, y, z, t]^3 + Derivative[0, 0, 0, 2][u1][x, y, z, t] +
(3*λ*Derivative[0, 0, 1, 0][u1][x, y, z, t]^2*Derivative[0, 0, 2, 0][u1][x, y, z, t])/2 +
μ*Derivative[0, 0, 2, 0][u2][x, y, z, t]
8
Try this:
J /: Power[J, p_Integer?OddQ] := J
J /: Power[J, p_Integer?EvenQ] := 1
J^Range[-10, 10]
{1, J, 1, J, 1, J, 1, J, 1, J, 1, J, 1, J, 1, J, 1, J, 1, J, 1}
8
You can check whether the Head of the expression is Plus, which is associated with a non-factored polynomial:
list = { 1 + x^2,
(-1 + x) (1 + x + x^2),
(1 + x)^2,
2 (2 + x + x^2),
2 (2 + x)^2
};
ClearAll[isF]
isF[Times[_Integer, poly_]] := isF[poly]
isF[poly_] := Head[poly] =!= Plus
SetAttributes[isF, Listable]
isF@...
7
It's clear from the box form of the expression in the notebook you linked that there is a misplaced RowBox wrapping the Mpc together with the right parenthesis that immediately precedes the ^(1/2) power. This is then incorrectly interpreted as Mpc being inside the square root. I have no idea how this RowBox got there, but when I simply highlight this ...
7
For the first part of your question please see a very recent Q&A:
"How is + as an infix operator associated with Plus?"
There you will find everything about defining operators yourself. For the second part, lets use your definition and bind it to CircleTimes.
CircleTimes[a_, b_] := a + a*b + b;
Now you can verify some of your assumptions. I use ...
7
Update: it seems this only works in 10.1 and later, but not in 10.0.
This works:
Assuming[(a | b | c) ∈ Matrices[{d, d}], TensorExpand@Transpose[a.(b + c)]]
(* Transpose[b, {2, 1}].Transpose[a, {2, 1}] + Transpose[c, {2, 1}].Transpose[a, {2, 1}] *)
We needed to tell Mathematica that a, b and c are square matrices and use TensorExpand.
Check here: ...
7
Maybe you can use the following:
ClearAll[dmydot, mydot]
Derivative[ndiff__][mydot][x__] := dmydot[ndiff][x];
dmydot /: Times[f__, dmydot[n1___, 1, n2___][x__]] :=
mydot @@ MapAt[Times[f] &, {x}, Length[{n1}] + 1]
All I'm doing here is pull the inner derivative that came from the chain rule back into the mydot to replace the original entry at that ...
7
Represent a string of field operators a[k]$\equiv\hat{a}(k)$ and ad[k]$\equiv\hat{a}^\dagger(k)$sandwiched between the ground state as correlate.
Then the definitions that will automate the manipulations is as follows:
ClearAll[correlate];
(* Normalization <0|0> = 1 *)
correlate[] = 1;
(* Commutation relation: [a(k1), a†(k2)] = δ(k1-k2) *)
...
7
Rewriting your definitions slightly
poly = (2 x1 x2 x5 x6 y2 (x2 y1 + x3 (y1 + y2)) y3^2 y4 (x5 y5 +
x4 (y4 + y5)))/((x2 y2 + x1 (y1 + y2)) (x3 y3 + x2 (y2 + y3))^2 (x4 y3 +
x5 (y3 + y4))^2 (x5 y4 + x6 (y4 + y5)));
eqns = {
K1 == ((x2 y2 + x1 (y1 + y2)) (x3 y3 + x2 (y2 + y3)))/(x2 y2 (x3 y3 +
x2 (y2 + y3) + x1 (y1 + y2 + y3))),
K2 == (...
7
An easy way to munge equations is to convert them to lists and then convert them back to equations when you are done munging. In your case, like so:
eq1 = -2 x + f[x, y[x]] - x^2 y[x]^3 == hy[y[x]];
eq2 = -2 E^(4 y[x]) + f[x, y[x]] - x^2 y[x]^3 == hx[x];
w1 = List @@ eq1;
w2 = List @@ eq2;
w3 = w1 - w2;
eq3 = Equal @@ w3
2 E^(4 y[x]) - 2 x == -hx[x] + ...
7
I'm going to guess that your actual goal here is to eliminate one of the terms shared by the two equations. In that case, you could also use Eliminate:
Eliminate[{eqfhx,eqhy},f[x,y[x]]]
$\text{hy}(y(x))-2 e^{4 y(x)}+2 x=\text{hx}(x)$
This doesn't do the subtraction exactly the way you asked for, but usually the goal of such a subtraction is to eliminate ...
7
How about that
-1 + x^(2/3) // ComplexExpand[#, TargetFunctions -> {Re, Im}] & //
FullSimplify // Factor // PowerExpand
(* (-1 + x^(1/3)) (1 + x^(1/3)) *)
6
By default, Mathematica always differentiates function heads that contain the independent differentiation variables, unless the function head is listed in the "DifferentiationOptions"->"ExcludedFunctions" system options. So, we can get the behavior you want by adding mydot to this list:
SetSystemOptions[
"DifferentiationOptions" ->
"...
6
Starting in version 10 you can used Indexed to make use of subscript formatting of list indices.
sol = Solve[1/y == 1/Indexed[r, 1] + 1/Indexed[r, 2], y]
(* {{y -> (Indexed[r, {1}] Indexed[r, {2}])/(Indexed[r, {1}] + Indexed[r, {2}])}} *)
You can then replace r by its list directly.
sol /. r -> {q, w}
(* {{y -> (q w)/(q + w)}} *)
Hope this helps....
6
There is a new paclet for doing Geometric Algebra:
PacletInstall["https://wolfr.am/N9OenlOc"]
<< GeometricAlgebra`;
You can construct multivectors of any algebra with it, and use it in computations:
{e1, e2, e3} = MultivectorBasis[GeometricAlgebra[3], 1];
e1 ** e2 ** e1 ** e2
(e1 ** e2) ^ 2
e1 ^ (3/5)
And more:
Inverse[2 e1]
MultivectorFunction[...
6
One should really use commutator rather than Commutator for future-proofing concerns, but I have some bad habits...
Clear[Commutator]
(* Manually implement the algebra of interest: *)
Commutator[L1, L2] = I L3; Commutator[L2, L1] = -I L3;
Commutator[L2, L3] = I L1; Commutator[L3, L2] = -I L1;
Commutator[L3, L1] = I L2; Commutator[L1, L3] = -I L2;
(* ...
6
{a, b} = Pick[r, Element[#, Rationals] & /@ List @@ r, #] & /@ {True, False}
{1, Sqrt[2] + Sqrt[13]}
6
abeliannessForcingNumberQ[n_Integer] := And @@ Flatten[{
Table[Not@Divisible[Power @@ p - 1, q], {p, FactorInteger[n]}, {q, First /@ FactorInteger[n]}],
Thread[Last /@ FactorInteger[n] <= 2]
}]
Select[Range[20], abeliannessForcingNumberQ]
(* 2, 3, 4, 5, 7, 9, 11, 13, 15, 17, 19 *)
See also A051532.
answered Jul 9 '19 at 23:10
AccidentalFourierTransform
9,1521 gold badge15 silver badges48 bronze badges
6
The easiest way is to just work it out. First let's implement a version of L using NonComutativeMultiply:
L[a_, b_] := Plus @@ Map[
Distribute[#, Plus, NonCommutativeMultiply]&,
{T[a] ** b, a ** T[b], b ** T[a], T[b] ** a}
]
The Distribute makes sure that all the multiplications are expanded out. By using Plus, identical terms will be grouped ...
Only top voted, non community-wiki answers of a minimum length are eligible
