# Tag Info

10

You can guide the simplification by providing a ComplexityFunction. It seems that your aim is to make the denominator as simple as possible. With that in mind, I tried the following Assuming[-1 < x < 1 && -1 < y < 1, FullSimplify[sol, ComplexityFunction -> (LeafCount[Denominator[#]] &)]] // Simplify (* Sqrt[(-x + Sqrt[x^...

7

This problem can be solved symbolically, although perhaps not with DEigensystem. Instead, begin with DSolve. s = DSolveValue[{2 x y''''[x] + 4 y'''[x] == lamda y''[x], y == 0, y'[1/2] == 0, y''[1/2] == lamda y[1/2]}, y[x], x] // FullSimplify (* (16 C (BesselI[0, Sqrt[lamda]] (-1 + 2 x + Sqrt Sqrt[lamda] Sqrt[x] BesselK[1, Sqrt Sqrt[...

6

This f = (6 P1y P1z P2y P2z + 6 P1x P2x (P1y P2y + P1z P2z) + P1x^2 (4 P2x^2 + P2y^2 + P2z^2) + P1y^2 (P2x^2 + 4 P2y^2 + P2z^2) + P1z^2 (P2x^2 + P2y^2 + 4 P2z^2)); Simplify[f,Assumptions->{X == (P1x P2x + P1y P2y + P1z P2z)^2, Y == (P1x^2 + P1y^2 + P1z^2) (P2x^2 + P2y^2 + P2z^2)}] instantly returns 3*X + Y If you defined your own functions X ...

4

First solving Clear[x, y] sol = DSolve[2 x y''''[x] + 4 y'''[x] == lambda y''[x], y, x][] yx = y[x] /. sol and then the boundary conditions equ1 = (D[yx, x] /. {x -> 1/2}) // FullSimplify equ2 = ((D[yx, {x, 2}] - lambda yx) /. {x -> 1/2}) // FullSimplify equ3 = Limit[yx, x -> 0] // FullSimplify equ4 = Limit[D[yx, x], x -> 0] - dy0 giving (...

4

Echoing Nasser, the solution is messy because the ODE is messy. There is not much you can do. You can massage the solution into a slightly more compact form as follows: let $q_i$ be the solutions to the algebraic equation $$q^3+ \alpha q^2- \left(\beta +\frac{\pi ^2 n^2}{d^2}\right)q-\frac{\pi ^2 \alpha n^2}{d^2}=0$$ i.e., q[i_] :> Root[(n^2 π^2 α)/d^...

4

I think @SimonWoods's tweak of my faulty idea should be posted as a possible answer: Collect[#, y] & /@ Collect[u[x, y] u1[1/x, 1/y], {x, y}]

3

As already noted, it is simply possible that FullSimplify[]'s (and even FunctionExpand[]'s) collection of transformations are not enough to deal with this problem. (See this for another example.) In this case, however, one can enlist DifferentialRootReduce[] to prove what is needed: DifferentialRootReduce[2/33 (-11 HypergeometricPFQ[{5/6}, {3/2, 11/6}, -(x^...

2

Mathematica has lots of tools for polynomials, but few for Laurent polynomials (Series will return a truncated Laurent series) and none really for treating monomials in multivariate polynomials as a flat sum. To get at the monomials of a polynomial (not a Laurent polynomial), one can use CoefficientList or CoefficientArrays. I used Series to find the ...

2

For this sort of problem, I like to use the 3-arg version of Collect. For example: tmp = Collect[u[x, y] u1[1/x, 1/y], {x, y}, Hold] Hold[E^(-((2 I π)/3))]/y + ( Hold[E^((2 I π)/3)] + y Hold[1 + E^(-((2 I π)/3))])/x + Hold[3 + E^(-((2 I π)/3)) + E^((2 I π)/3)] + x (y Hold + Hold[1 + E^((2 I π)/3)]/y + Hold[2 E^(-((2 I π)/3)) + E^((2 ...

2

Try this: expr = n^a/(n*b)^c; expr // PowerExpand (* b^-c n^(a - c) *) Do not use the capital N since in Mma it is a service word. Have fun!

1

summarize the comment to solve this problem,we can FullSimplify[Sin[2*Pi*f0*n*ts] /. f0 -> 1/(2 ts), Element[n, Integers]] or Assuming[Element[n, Integers], Simplify[Sin[2*Pi*f0*n*ts] /. f0 -> 1/(2*ts)]] besides,-> is equal to Rule,it won't pollute the "variable space" ,but = equal to Set,which will, so you'd better choose Block or With or Module ...

1

I'm not sure this is what is sought but it might give some ideas. ee = -1.52537 - 2.54462 Cos[\[Delta]]^3 + Cos[\[Delta]]^2 (2.94197 - 1.35683 Sin[\[Delta]]) + 2.44869 Sin[\[Delta]] - 0.853005 Sin[\[Delta]]^2 + Cos[\[Delta]] (4.69792 - 2.41511 Sin[\[Delta]] - 0.180872 Sin[\[Delta]]^2) + Sqrt[1/25 - (0.102901 - 0.19724 Cos[\[Delta]] - ...

1

On the simple example, something like this does the work: CoefficientList[expr, DeleteDuplicates@Cases[expr, Power[_, 1/2], Infinity]] On the more complicated ones, a better example would be needed for me to test how to extend the above idea. OP's example: sqrts = DeleteDuplicates@Cases[expr, Power[_, 1/2], Infinity] (* {Sqrt[1/25 - (0.102901 - 0.19724 ...

1

Here's a high-school algebra approach: $rat = # /. Power[a_ + s_.*Sqrt[b_], -1] :> Power[(a^2 - s^2 b)/(a - s*Sqrt[b]), -1] &; sol //$rat (* Sqrt[-((x - Sqrt[x^2 + y^2])/y^2)] *) Other variants: The Power[.., -1] pattern above limits the applicability to a simple factor in the denominator (anywhere in the expression, by the way!). $rat = #... 1 Try also this: Sqrt[Numerator[sol[]]*(x - Sqrt[x^2 + y^2])/ Expand[Denominator[sol[]]*(x - Sqrt[x^2 + y^2])]] (* Sqrt[-((x - Sqrt[x^2 + y^2])/y^2)] *) Have fun! 1 Let's make a helper function: s[x0_, y0_] := Normal@Series[Series[f[x, y], {x, x0, 1}], {y, y0, 1}] Now we can compute series expansions: Limit[s[x0, y0], Thread[{x0, y0} -> r1], Direction -> "FromAbove"] -(1/8) x (-12 + 4 Sqrt π - 9 y) Limit[s[x0, y0], Thread[{x0, y0} -> r1], Direction -> "FromBelow"] 1/8 x (-12 + 4 Sqrt π - 9 y) ... 1 I do not think you can get such approximation across a cuspid, hence you have to consider only one side of it, for instance s1[x_,y_] = Assuming[x > 0 && y > d, Series[f[x, y], {x, 0, 1}, {y, d, 1}] ] // Normal s1[x,y]//N 1.5 (-2.4184 + y) Plot3D[{s1[x, y], f[x, y]}, {x, -.01, .01}, {y, d - .01, d + .01} , AspectRatio -> 1] 1 Clear["Global`*"]; phi = 2 Pi/3; u[x_, y_] := Exp[-I phi] x + Exp[I phi] y + x y; u0[x_, y_] := 1 + Exp[I phi] x + Exp[-I phi] y; u1[x_, y_] = u0[x, y] + u[x, y]; expr = u[x, y] u1[1/x, 1/y]; expr2 = (Simplify /@ Collect[expr /. {x -> t*x, y -> t*y}, t]) /. t -> 1 expr == expr2 // Simplify (* True *) 1 This is another way, albeit ad hoc, to do it. phi = 2 Pi/3; u[x_, y_] := Exp[-I phi] x + Exp[I phi] y + x y; u1[x_, y_] = u0[x, y] + u[x, y]; Module[{a, b}, a = Collect[#, x] & /@ Collect[u[x, y] u1[1/x, 1/y], y]; b = (Collect[#, y] & /@ Collect[u[x, y] u1[1/x, 1/y], x])[]; a[[;; 4]] + b + a[[7 ;;]]] 1 You can use PiecewiseExpand to make sure the conditions are disjoint. For your example: pw = Piecewise[{{x, 3*x > y && x < 2*y}, {y, 2*x > y && x < 3*y}}, 0]; disjoint = PiecewiseExpand[ pw, Method -> {"OrderlessConditions"->True, "ConditionSimplifier"->FullSimplify} ]; disjoint //TeXForm$\begin{cases} x &...

1

Another approach: sub[poly_, x_] := Module[{cc, reduced, d}, cc = Abs@Rest@CoefficientList[poly, x]; reduced = DeleteCases[Except[_Integer]] /@ (cc^(1/Range[Length@cc])); d = GCD @@ reduced; x -> x/d ]; Examples: pol /. sub[pol, x] (* 80 - 8 x - 3 x^2 *) pol2 = 145 + 5556600 x + 28991671632 x^2 + 57456600591796875000000 x^3 + ...

1

This seems to work correctly: subsimp[pol_] := Module[{co, pr, ex, d}, co = Abs[CoefficientList[pol, x][[2 ;; -1]]]; pr = Intersection @@ (FactorInteger[#][[All, 1]] & /@ co); ex = Min /@ Transpose[ Quotient[IntegerExponent[Coefficient[pol, x, #], pr], #] & /@ Range[Length[co]]]; d = Times @@ (Power @@@ Transpose[{pr, ex}]); ...

1

At least for this simple example, using Solve seems to get close: Solve[z == λ && m^2==1 && m ∈ Integers, z] {{z -> ConditionalExpression[1/(a - b), m == -1]}, {z -> ConditionalExpression[1/(a + b), m == 1]}}

1

Try this: λ1 = (1 + m)/2 (a + b) + (1 - m)/2 (a - b); λ2 = (1 + m)/2 1/(a + b) + (1 - m)/2 1/(a - b); Now let us transform: λ1 // Expand (* a + b m *) λ2 // Together // ExpandDenominator (* (a - b m)/(a^2 - b^2) *) This requires no special trick to cope with m=+/-1. Have fun!

1

bf = ButterworthFilterModel[{"Lowpass", 2, 2 π 500.}]; Convert a to exact values a = Rationalize[(bf[I 2 π f][[1, 1]]), 0] // Simplify; b1 = ComplexExpand[Re[a Conjugate[a]]] // Simplify; b2 = ComplexExpand[Abs[a]^2] // Simplify; b1 and b2 are identical b1 === b2 // FullSimplify (* True *) Further, with exact values it is not necessary to use Re in ...

1

Your have to help a bit to FoolSimplify[] f[e_] := 100 Count[e, _Gudermannian | _Csch, {0, Infinity}] + LeafCount[e] Assuming[p > 0, FullSimplify[2 ArcTan[Sinh[p]] == Pi - 2 ArcTan[Csch[p]], ComplexityFunction -> f]] (True)

Only top voted, non community-wiki answers of a minimum length are eligible