Simplify Absolute Value in Mathematica - wolfram-mathematica

I currently have a large expression with many terms of the form
Abs[-2 b + 2 d1 m + l Tan[\[Theta]]]
I know, from the geometry of my problem, that
-2 b + 2 d1 m + l Tan[\[Theta]] > 0
However, when I try to simplify my expression,
Simplify[Abs[-2 b + 2 d1 m + l Tan[\[Theta]]], -2 b + 2 d1 m + l Tan[\[Theta]] > 0]
I just get back
Abs[-2 b + 2 d1 m + l Tan[\[Theta]]]
How can I make Mathematica simplify out the unnecessary absolute value?
EDIT 1
The full expression which I'm trying to simplify is
-(1/(2 (m - Tan[\[Theta]])))
Sqrt[1 + m^2] (B2 Sqrt[(-2 b + 2 d1 m + l Tan[\[Theta]])^2] +
B4 Sqrt[(-2 b + 2 d2 m + l Tan[\[Theta]])^2] +
B5 Sqrt[(2 b + 2 d3 m + l Tan[\[Theta]])^2] +
B7 Sqrt[(2 b + 2 d4 m + l Tan[\[Theta]])^2] +
B1 Sqrt[(2 b - 2 (d1 + l) m + l Tan[\[Theta]])^2] +
B3 Sqrt[(2 b - 2 (d2 + l) m + l Tan[\[Theta]])^2] +
B6 Sqrt[(-2 (b + (d3 + l) m) + l Tan[\[Theta]])^2] +
B8 Sqrt[(-2 (b + (d4 + l) m) + l Tan[\[Theta]])^2])
The terms being squared under each of the radicals is known to be a positive real number.

Since the terms are all known to be real and positive, squaring and taking the square-root will only give you the same number. Hence, you could do something like
expr /. Sqrt[(x___)^2] :> x
where expr is your giant expression above.

Here are two ideas:
1)
Simplify[Abs[-2 b + 2 d1 m + l Tan[\[Theta]]],
0 < \[Theta] < \[Pi]/2 && l > 0 && 2 d1 m > 0 && -2 b > 0]
2)
f[e_] := 100 Count[e, _Abs, {0, Infinity}] + LeafCount[e]
Simplify[Abs[-2 b + 2 d1 m + l Tan[\[Theta]]], -2 b + 2 d1 m +
l Tan[\[Theta]] > 0, ComplexityFunction -> f]
Th complexity function f makes Abs more expensive than Times. See docu for Simplify. Does that help?

If you only wish to remove specific instances of absolute value, you could do something along these lines:
Clear[removeAbs]
removeAbs[expr_, r_] := expr /. {Sqrt[r^2] :> r, Abs[r] :> r}
That way it only removes the absolute value from any expressions you specify:
In: removeAbs[Abs[x] + Abs[y], x]
Out: x + Abs[y]
I'll see if I can find a nicer looking solution than this.

I'm constantly stimied by things like Abs[a]^2, and stuff like using Assuming with a\[Element]Reals doesn't help.
I found some help here WolframMathWorld - Absolute Square with ComplexExpand[Abs[a]^2, TargetFunctions -> {Conjugate}], but sometimes it still returns stuff like Conjugate[Sqrt[a^2 + b^2]] and I've found wrapping a second ComplexExpand (without parameters) around that helps.

Related

Finding the largest power of a number that divides a factorial in haskell

So I am writing a haskell program to calculate the largest power of a number that divides a factorial.
largestPower :: Int -> Int -> Int
Here largestPower a b has find largest power of b that divides a!.
Now I understand the math behind it, the way to find the answer is to repeatedly divide a (just a) by b, ignore the remainder and finally add all the quotients. So if we have something like
largestPower 10 2
we should get 8 because 10/2=5/2=2/2=1 and we add 5+2+1=8
However, I am unable to figure out how to implement this as a function, do I use arrays or just a simple recursive function.
I am gravitating towards it being just a normal function, though I guess it can be done by storing quotients in an array and adding them.
Recursion without an accumulator
You can simply write a recursive algorithm and sum up the result of each call. Here we have two cases:
a is less than b, in which case the largest power is 0. So:
largestPower a b | a < b = 0
a is greater than or equal to b, in that case we divide a by b, calculate largestPower for that division, and add the division to the result. Like:
| otherwise = d + largestPower d b
where d = (div a b)
Or putting it together:
largestPower a b | a < b = 1
| otherwise = d + largestPower d b
where d = (div a b)
Recursion with an accumuator
You can also use recursion with an accumulator: a variable you pass through the recursion, and update accordingly. At the end, you return that accumulator (or a function called on that accumulator).
Here the accumulator would of course be the running product of divisions, so:
largestPower = largestPower' 0
So we will define a function largestPower' (mind the accent) with an accumulator as first argument that is initialized as 1.
Now in the recursion, there are two cases:
a is less than b, we simply return the accumulator:
largestPower' r a b | a < b = r
otherwise we multiply our accumulator with b, and pass the division to the largestPower' with a recursive call:
| otherwise = largestPower' (d+r) d b
where d = (div a b)
Or the full version:
largestPower = largestPower' 1
largestPower' r a b | a < b = r
| otherwise = largestPower' (d+r) d b
where d = (div a b)
Naive correct algorithm
The algorithm is not correct. A "naive" algorithm would be to simply divide every item and keep decrementing until you reach 1, like:
largestPower 1 _ = 0
largestPower a b = sumPower a + largestPower (a-1) b
where sumPower n | n `mod` b == 0 = 1 + sumPower (div n b)
| otherwise = 0
So this means that for the largestPower 4 2, this can be written as:
largestPower 4 2 = sumPower 4 + sumPower 3 + sumPower 2
and:
sumPower 4 = 1 + sumPower 2
= 1 + 1 + sumPower 1
= 1 + 1 + 0
= 2
sumPower 3 = 0
sumPower 2 = 1 + sumPower 1
= 1 + 0
= 1
So 3.
The algorithm as stated can be implemented quite simply:
largestPower :: Int -> Int -> Int
largestPower 0 b = 0
largestPower a b = d + largestPower d b where d = a `div` b
However, the algorithm is not correct for composite b. For example, largestPower 10 6 with this algorithm yields 1, but in fact the correct answer is 4. The problem is that this algorithm ignores multiples of 2 and 3 that are not multiples of 6. How you fix the algorithm is a completely separate question, though.

Trying to create an efficient algorithm for a function in Haskell

I'm looking for an efficient polynomial-time solution to the following problem:
Implement a recursive function node x y for calculating the (x,y)-th number in a number triangle defined as
g(x,y) = 0 if |x| > y
= 1 if (x,y) = (0,0)
= sum of all incoming paths otherwise
The sum of all incoming paths to a node is defined as the sum of the values of all possible paths from the root node (x, y) = (0, 0) to the node under consideration, where at each node (x,y) a path can either continue diagonally down and left (x−1,y+1), straight down (x,y+1), or diagonally down and right (x+1,y+1). The value of a path to a node is defined as the sum of all the nodes along that path up to, but not including, the node under consideration.
The first few entries in the number triangle are given in the table:
\ x -3 -2 -1 0 1 2 3
\
y \ _________________________
|
0 | 0 0 0 1 0 0 0
|
1 | 0 0 1 1 1 0 0
|
2 | 0 2 4 6 4 2 0
|
3 | 4 16 40 48 40 16 4
I am trying to work out a naive solution first, here is what I have:
node x y | y < 0 = error "number cannot be negative"
| (abs x) > y = 0
| (x == 0) && (y == 0) = 1
| otherwise = node (x+1) (y-1) + node x (y-1) + node (x-1) (y-1)
Whenever I run this I get:
"* Exception: stack overflow"?
I believe your problem is a bit more complicated than your example code suggests. First, let's be clear about some definitions here:
Let pathCount x y be the number of paths that end at (x, y). We have
pathCount :: Int -> Int -> Integer
pathCount x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]
Now let's pathSum x y be the sum of all paths that end in (x, y). We have:
pathSum :: Int -> Int -> Integer
pathSum x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
| d <- [-1..1] ]
With this helper, we can finally define node x y properly:
node :: Int -> Int -> Integer
node x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]
This algorithm as such is exponential time in its current form. We can however add memoization to make the number of additions quadratic. The memoize package on Hackage makes this easy as pie. Full example:
import Control.Monad
import Data.List (intercalate)
import Data.Function.Memoize (memoize2)
node' :: Int -> Int -> Integer
node' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]
node = memoize2 node'
pathCount' :: Int -> Int -> Integer
pathCount' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]
pathCount = memoize2 pathCount'
pathSum' :: Int -> Int -> Integer
pathSum' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
| d <- [-1..1] ]
pathSum = memoize2 pathSum'
main =
forM_ [0..n] $ \y ->
putStrLn $ intercalate " " $ map (show . flip node y) [-n..n]
where n = 5
Output:
0 0 0 0 0 1 0 0 0 0 0
0 0 0 0 1 1 1 0 0 0 0
0 0 0 2 4 6 4 2 0 0 0
0 0 4 16 40 48 40 16 4 0 0
0 8 72 352 728 944 728 352 72 8 0
16 376 4248 16608 35128 43632 35128 16608 4248 376 16
As you can see the algorithm the size of the numbers will get out of hands rather quickly. So the runtime is not O(n^2), while the number of arithmetic operations is.
You're thinking in terms of outgoing paths, when you should be thinking in terms of incoming paths. Your recursive step is currently looking for nodes from below, instead of above.
First of all, sorry if this is long. I wanted to explain the step by step thought process.
To start off with, you need one crucial fact: You can represent the "answer" at each "index" by a list of paths. For all the zeros, this is [[]], for your base case it is [[1]], and for example, for 0,2 it is [[6,1,1],[6,1,1],[6,1,1]]. This may seem like some redundancy, but it simplifies things down the road. Then, extracting the answer is head . head if the list is non empty, or const 0 if it is.
This is very useful because you can store the answer as a list of rows (the first row would be '[[1]], [], [] ...) and the results of any given row depend only on the previous row.
Secondly, this problem is symmetrical. This is pretty obvious.
The first thing we will do will mirror the definition of fib very closely:
type Path = [[Integer]]
triangle' :: [[Path]]
triangle' = ([[1]] : repeat []) : map f triangle'
We know this must be close to correct, since the 2nd row will depend on the first row only, the third on the 2nd only, etc. So the result will be
([[1]] : repeat []) : f ([[1]] : repeat []) : f ....
Now we just need to know what f is. Firstly, its type: [Path] -> [Path]. Quite simply, given the previous row, return the next row.
Now you may see another problem arising. Each invocation of f needs to know how many columns in the current row. We could actually count the length of non-null elements in the previous row, but it is simpler to pass the parameter directly, so we change map f triangle' to zipWith f [1..] triangle', giving f the type Int -> [Path] -> [Path].
f needs to handle one special case and one general case. The special case is x=0, in this case we simply treat the x+1,y-1 and x-1,y-1 recursions the same, and otherwise is identical to gn. Lets make two functions, g0 and gn which handle these two cases.
The actually computation of gn is easy. We know for some x we need the elements x-1, x, x+1 of the previous row. So if we drop x-1 elements before giving the previous row to the xth invocation of gn, gn can just take the first 3 elements and it will have what it needs. We write this as follows:
f :: Int -> [Path] -> [Path]
f n ps = g0 ps : map (gn . flip drop ps) [0..n-1] ++ repeat []
The repeat [] at the end should be obvious: for indices outside the triangle, the result is 0.
Now writing g0 and gs is really quite simple:
g0 :: [Path] -> Path
g0 (a:b:_) = map (s:) q
where
s = sum . concat $ q
q = b ++ a ++ b
gn :: [Path] -> Path
gn (a:b:c:_) = map (s:) q
where
s = sum . concat $ q
q = a ++ b ++ c
On my machine this version is about 3-4 times faster than the fastest version I could write with normal recursion and memoization.
The rest is just printing or pulling out the number you want.
triangle :: Int -> Int -> Integer
triangle x y = case (triangle' !! y) !! (abs x) of
[] -> 0
xs -> head $ head xs
triList :: Int -> Int -> Path
triList x y = (triangle' !! y) !! (abs x)
printTri :: Int -> Int -> IO ()
printTri width height =
putStrLn $ unlines $ map unwords
[[ p $ triangle x y | x <- [-x0..x0]] | y <- [0..height]]
where maxLen = length $ show $ triangle 0 height
x0 = width `div` 2
p = printf $ "%" ++ show maxLen ++ "d "

In Mathematica, how can I cut off the high-order terms in a polynomial?

For example, I have a polynomial y=a_0+a_1 x + ..... + a_50 x^50. Since I know that the high-order terms are imposing negligible effects on the evaluation of y, I want to cut off them and have something like y=a_0+a_1 x + ..... + a_10 x^10, the first eleven terms. How can I realize this?
I thank you all in advance.
In[1]:= y = a0 + a1*x + a2*x^2 + a3*x^3 + a4*x^4;
y /. x^b_ /; b >= 3 -> 0
Out[2]= a0 + a1 x + a2 x^2
The mathematically proper approach..
Series[ a0 + a1*x + a2*x^2 + a3*x^3 + a4*x^4, {x, 0, 2}] // Normal
-> a0 + a1 x + a2 x^2
If your polynomial is actually as simple as shown, with a term for every power of x and none others, you can simply use Take or Part to extract only those terms that you want because of the automatic ordering (in Plus) that Mathematica uses. For example:
exp1 = Expand[(1 + x)^9]
Take[exp1, 5]
1 + 9 x + 36 x^2 + 84 x^3 + 126 x^4 + 126 x^5 + 84 x^6 + 36 x^7 + 9 x^8 + x^9
1 + 9 x + 36 x^2 + 84 x^3 + 126 x^4
If it is not you will need something else. Bill's replacement rule is one concise and efficient method. For more complex manipulations you may wish to decompose the polynomial using CoefficientArrays, CoefficientRules, or CoefficientList.
There is a shortcut to the previous answers which is even more symbolic. You write, say,
y[x_] = a0 + a1 x + a2 x^2 + a3 x^3 + a4 x^4 + a5 x^5;
y[x] + O[x]^3
which gives you,
a0 + a1 x + a2 x^2 + O[x]^3

Solve Equations from Equations Mathematica

Well, I need a way to solve equations by another var got from other equation in Mathematica 8. Example:
a + b = 2c
c + 2 = d
d = 2b
It will chose the best equation for the given values and solve the rest.
With some given values, like a = 1 and c = 3, it solves the system, getting the values for the respective variable.
*Will use this for physics' formulas.
Use the Solve or Reduce functions. The syntax is
Solve[{LIST OF EQUATIONS}, {Variables to solve for}]
So in this case:
Solve[{a + b == 2 c, c + 2 == d, d == 2 b}, {a, b, c, d}]
(*->
{{a -> -4 + (3 d)/2, b -> d/2, c -> -2 + d}}
*)
There are 4 variables and only 3 equations, so there are infinite solutions.
They lie on the 4-d line (-4 + (3 n)/2, n/2, n-2, n).

Matrix factorise of vector

Say I have a vector that looks like this:
1/2 a + 1/3 b
b + c
2a + c
1/3c + 4d
Mathematically this can be factorised into matrix and a vector:
Matrix:
1/2 1/3 0 0
0 1 1 0
2 0 1 0
0 0 1/3 4
Vector:
a
b
c
d
(My apologies for the formatting, perhaps someone could suggest how better to do it?)
Is there any way to get mathematica to do this matrix factorisation? In my specific case the terms are not simple expressions such as "a", "b", "c", "d". But are things indexed by a list, e.g.
W[{3,0,0,0}]
W[{1,1,0,0}]
W[{0,0,1,0}]
Thanks!
Possibly:
x = {1/2 a + 1/3 b,
b + c,
2 a + c,
1/3 c + 4 d};
CoefficientArrays[x, {a, b, c, d}][[2]] // MatrixForm
In the case that you want coefficients for all variables, use the compact form:
CoefficientArrays[x][[2]] // MatrixForm
In the case that you do not want coefficients of all variables, part [[1]] comes into play:
x2 = {1/2 a + 1/3 b + q - y,
b + c + 1/2 r,
2 a + c + 2 y,
1/3 c + 4 d};
CoefficientArrays[x2, {a, b, c, d}][[1]] // Normal
{q - y, r/2, 2 y, 0}
Such that you can reconstruct your expression.

Resources