Download or view solvingTransformations.frink in plain text format
// These transformations try to solve simple equations and teach Frink to
// solve basic algebraic equations for the specified variable.
//
// For example, enter:
// solve[3(x+y) === 10, x]
//
// (Right now this requires the triple-equals sign because Frink currently
// requires that the left-hand-side of an assignment operator
// ( = ) can actually be meaningfully assigned to, which may be
// a constraint that needs to get loosened for temporary values.
// This creates a named list of transformations called "solving" that we
// can apply by name later.
transformations solving
{
// Change sqrt[x] into a power.
sqrt[_x] <-> _x^(1/2)
// Move the variable we're solving for to the left side of the equation
// if it's only on the right side of the equation.
solve[_left === _right, _x] :: (freeOf[_left, _x] AND expressionContains[_right, _x]) <-> solve[_right === _left, _x]
// Bailout condition
solve[_x === _z, _x] :: freeOf[_z, _x] <-> _x === _z
// Quadratic equations
solve[(_a:1) _x^2 + (_b:1) _x === _c, _x] :: freeOf[_c, _x] <-> [ solve[_x === (-_b + (_b^2 - 4 _a (-_c))^(1/2)) / (2 _a), _x], solve[_x === (-_b - (_b^2 - 4 _a (-_c))^(1/2)) / (2 _a), _x] ]
// Quadratic equation kludge.
// Distributing something like (2x + 3p)(3x + 1) gives a result like
// (6 x^2 + 9 p x + 2 x + 3p) which is a quadratic equation but has two
// terms of x. This handles that common case in an inelegant way.
// TODO: Find a better solution for this and remove it.
solve[(_a:1) _x^2 + (_b1:1) _x + _b2 _x === _c, _x] :: freeOf[_c, _x] <-> [ solve[_x === (-(_b1 + _b2) + ((_b1 + _b2)^2 - 4 _a (-_c))^(1/2)) / (2 _a), _x],solve[_x === (-(_b1 + _b2) - ((_b1 + _b2)^2 - 4 _a (-_c))^(1/2)) / (2 _a), _x] ]
// If both sides have an x, divide out x terms from right.
// solve[_a === (_c:1) _x^(_b:1), _x] :: expressionContains[_a, _x] <-> solve[_a / _x^_b === _c, _x]
// First move additive terms
// Move all x-containing terms to left
solve[_a === _c, _x] :: (expressionContains[_a, _x] && expressionContains[_c, _x]) <-> solve[_a - _c === 0, _x]
// Move all non-x-containing terms to right.
solve[_a + _b === _c, _x] :: (freeOf[_a,_x] AND expressionContains[_b, _x]) <-> solve[_b === _c - _a, _x]
// Then move multiplicative terms.
solve[_a * _b === _c, _x] :: (freeOf[_a,_x] AND expressionContains[_b, _x]) <-> solve[_b === _c / _a, _x]
// Flip inverse exponents.
solve[_a^_k is isNegative === _b, _c] :: expressionContains[_a, _c] <-> solve[_a^-_k === _b^-1, _c]
// Solve for two terms containing c
solve[_a _c + (_b:1) _c === _d, _c] :: freeOf[_a, _c] && freeOf[_b, _c] && freeOf[_d,_c] <-> solve[_c === _d / (_a + _b), _c]
// Solve for negative and positive exponents on same side.
solve[(_c1:1) _a^_k is isNegative + (_c2:1) _a^(_j:1) === _b, _c] :: expressionContains[_a, _c] && freeOf[_c1, _c] && freeOf[_c2, _c] <-> solve[_c1 + _c2 _a^(_j-_k) === _b _a^-_k, _c]
// Very general negative and positive exponents on same side.
solve[(_a:1) _x^_b is isNegative + _c === _d, _x] :: expressionContains[_c, _x] <-> solve[_a + _c _x^-_b === _d _x^-_b, _x]
// Help the solver to factor an expression.
solve[(_a:1) _x^_b + _c _x^_b === _d, _x] <-> solve[_x^_b === _d / (_a + _c), _x]
// x in numerator and denominator (denominator has additive term.)
solve[(_b:1) _x / ((_a:1) _x + _y) === _z, _x] :: freeOf[_b, _x] && freeOf[_a, _x] && freeOf[_y, _x] <-> solve[_x === _z (_a _x + _y) / _b, _x]
// x in denominator of complicated fraction and outside fraction.
solve[(_a:1) _x + (_b:1) / _d === _e, _x] :: expressionContains[_d, _x] <-> solve[_a _x _d + _b === _e _d, _x]
// Solve for squared terms.
// Results are a list of two different solutions.
solve[_a^_k is isPositive === _b, _c] :: expressionContains[_a, _c] AND (_k mod 2 == 0) <-> [ solve[_a^(_k/2) === _b^(1/2),_c] , solve[_a^(_k/2) === -_b^(1/2), _c ] ]
// a x + b (d+ (c x)^(1/2)) === z
// solve[(_a:1) _x + (_b:1) ((_d:0) + ((_c:1) _x)^(1/2)) === _z, _x] :: freeOf[_a, _x] and freeOf[_b,_x] and freeOf[_c, _x] and freeOf[_d, _x] and freeOf[_z, _x] <-> [ solve[sqrt[-4 _a _b^3 _c _d + 4 _a _b^2 _c _z + _b^4 _c^2] - 2 _a _b _d + 2 _a _z + _b^2 _c, _x], solve[-sqrt[-4 _a _b^3 _c _d + 4 _a _b^2 _c _z + _b^4 _c^2] - 2 _a _b _d + 2 _a _z + _b^2 _c, _x] ]
// Force grouping of terms together. Note that this is the inverse of the
// distributive transform below and could cause loops.
solve[(_a:1) _x + (_b:1) _x + (_c:0), _x] <-> solve[_x (_a + _b) + _c, _x]
// a x^(1/2) + b x== d
// solve[((_a:1) _x^(1/2)) + (_b:1) _x === _d, _x] :: freeOf[_a, _x] and freeOf[_b,_x] and freeOf[_d, _x] <-> [ solve[_x === (_a sqrt[_a^2 + 4 _b _d] + _a^2 + 2 _b _d)/(2 _b^2), _x], solve[_x === (-_a sqrt[_a^2 + 4 _b _d] + _a^2 + 2 _b _d)/(2 _b^2), _x]]
// General solving help when a term includes x + x^(1/2) terms.
// Shift the x^(1/2) term to one side of the equals sign and square both
// sides. This generally lets it be solved by the quadratic equation.
solve[_a + (_d:1) _b^(1/2) === _c, _x] :: expressionContains[_a, _x] and expressionContains[_b, _x] and freeOf[_c, _x] and freeOf[_d, _x] <-> solve[(_a - _c)^2 === _d^2 _b, _x]
// General solving help when a term includes x * x^(1/2) terms.
// Shift the x^(1/2) term to one side of the equals sign and square both
// sides.
solve[_a _b^(1/2) + (_d:0) === _c, _x] :: expressionContains[_a, _x] and expressionContains[_b, _x] and freeOf[_c, _x] <-> solve[_b _a^2 === (_c-_d)^2, _x]
// General solving help when a term includes x * x^(-1/2) terms.
// Shift the x^(-1/2) term to one side of the equals sign and square both
// sides.
solve[_a _b^(-1/2) + (_d:0) === _c, _x] :: expressionContains[_a, _x] and expressionContains[_b, _x] and freeOf[_c, _x] <-> solve[_b === _a^2 / (_c-_d)^2, _x]
// General solving help when a term contains a x + b (c + d x)^2 terms.
// Expand out (c + d x) which usually allows the equation to be solved
// with the quadratic equation.
// TODO: Generalize this for cubed terms, etc
solve[(_a:1) + (_b:1) (_c + (_d:1) _x)^2 === _f, _x] :: expressionContains[_a, _x] and freeOf[_c, _x] and freeOf[_f, _x] <-> solve[_a + _b (_c^2 + 2 (_c _d _x) + _d^2 _x^2) === _f, _x]
// Solving help with two fractions with denominators containing x.
// THIS CREATES AN INFINITE LOOP SOMEWHERE
// solve[(_a:1) / _b + (_c:1) / _d === _f, _x] :: expressionContains[_b, _x] and expressionContains[_d, _x] and freeOf[_a, _x] and freeOf[_c, _x] <-> solve[(_a _d + _b _c) / (_b _d) === _f, _x]
// a x (b + c x^2)^(-1/2) == d
// solve[(_a:1) _x (_b + (_c:1) _x^2)^(-1/2) === _d, _x] <-> [solve[_x === i _b^(1/2) _d / (_c _d^2 - _a^2)^(1/2), _x], solve[_x === -i _b^(1/2) _d / (_c _d^2 - _a^2)^(1/2), _x]]
// _a + (_b + _x)^2 == d with a containing x. Multiply out the parens.
solve[_a + (_b + (_c:1) _x)^2 === _d, _x] :: expressionContains[_a, _x] <-> solve[_a + _b^2 + 2 _b _c _x + _c^2 _x^2 === _d, _x]
// Factor out 3 terms. TODO: Generalize this!
solve[(_a:1) _x + _b _x + _c _x === _d, _x] <-> solve[(_a + _b + _c) _x === _d, _x]
// Solve for powers of 3, 6, 9, etc.
solve[_a^_k is isPositive === _b, _c] :: expressionContains[_a, _c] AND (_k mod 3 == 0) <-> [ solve[_a^(_k/3) === _b^(1/3),_c] , solve[_a^(_k/3) === -((-1)^(1./3)) _b^(1/3), _c ], solve[_a^(_k/3) === ((-1)^(2./3)) _b^(1/3), _c ] ]
// Solve for rational exponents
solve[_a^_k is isRational === _b, _c] :: expressionContains[_a, _c] <-> solve[_a === _b^(1/_k),_c]
// Gah! Cubic equations!
// See http://en.wikipedia.org/wiki/Cubic_function#General_formula_of_roots
//
// See https://brilliant.org/wiki/cubic-discriminant/
// The discriminant of a x^3 + b x^2 + c x == d is
// delta = b^2 c^2 - 4 a c^3 + 4b^3 d - 27 a^2 d^2 - 18 a b c d
// (note that this is different than the usual discriminant equation
// because Frink's solvers will put d on the right-hand side of the
// equation so d is replaced with -d)
//
// If delta > 0 then the equation has three distinct real roots.
// if delta == 0 then the equation has a repeated root and all its roots are real.
// if delta < 0 then the equation has one real root and two non-real complex conjugate roots. (which is currently what is solved below.)
//
// TODO: Find a way to store repeated temporary parts of results into variables.
// Solving when a, b, and c are all defined.
solve[(_a:1) _x^3 + (_b:1) _x^2 + (_c:1) _x === _d, _x] :: freeOf[_d, _x] <-> [solve[_x === -_b/(3 _a) - (2^(1/3)*(-_b^2 + 3 _a _c))/ (3 _a (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)) + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)/(3*2^(1/3)*_a), _x],
solve[_x === -_b/(3 _a) + ((1 + i sqrt[3])*(-_b^2 + 3 _a _c))/ (3*2^(2/3) _a (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)) - ((1 - i sqrt[3])*(-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x],
solve[_x === -_b/(3 _a) + ((1 - i sqrt[3])*(-_b^2 + 3 _a _c))/ (3*2^(2/3)*_a*(-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)) - ((1 + i sqrt[3])*(-2 _b^3 + 9 _a _b _c + 27 _a^2 _d + sqrt[-4 (_b^2 - 3 _a _c)^3 + (-2 _b^3 + 9 _a _b _c + 27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x]]
// Cubic equation solver when b = 0 (coefficient of x^2)
solve[(_a:1) _x^3 + (_c:1) _x === _d, _x] :: freeOf[_d, _x] <-> [solve[_x === 0 - (2^(1/3)*(3 _a _c))/ (3 _a (27 _a^2 _d + sqrt[-4 (-3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)) + (27 _a^2 _d + sqrt[-4 (-3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)/(3*2^(1/3)*_a), _x],
solve[_x === ((1 + i sqrt[3])*(3 _a _c))/ (3*2^(2/3) _a (27 _a^2 _d + sqrt[-4 (-3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)) - ((1 - i sqrt[3])*(27 _a^2 _d + sqrt[-4 (-3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x],
solve[_x === ((1 - i sqrt[3])*(3 _a _c))/ (3*2^(2/3)*_a*(27 _a^2 _d + sqrt[-4 (3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)) - ((1 + i sqrt[3])*(27 _a^2 _d + sqrt[-4 (-3 _a _c)^3 + (27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x]]
// Cubic equation solver when c=0 (coefficient of x)
solve[(_a:1) _x^3 + (_b:1) _x^2 === _d, _x] :: freeOf[_d, _x] <-> [solve[_x === -_b/(3 _a) - (2^(1/3)*(-_b^2))/ (3 _a (-2 _b^3 + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)) + (-2 _b^3 + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)/(3*2^(1/3)*_a), _x],
solve[_x === -_b/(3 _a) + ((1 + i sqrt[3])*(-_b^2))/ (3*2^(2/3) _a (-2 _b^3 + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)) - ((1 - i sqrt[3])*(-2 _b^3 + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x],
solve[_x === -_b/(3 _a) + ((1 - i sqrt[3])*(-_b^2))/ (3*2^(2/3)*_a*(-2 _b^3 + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)) - ((1 + i sqrt[3])*(-2 _b^3 + + 27 _a^2 _d + sqrt[-4 (_b^2)^3 + (-2 _b^3 + 27 _a^2 _d)^2])^(1/3)) / (6*2^(1/3)*_a), _x]]
// Cubic equation solver
// See https://sciencing.com/solve-cubic-equations-8136094.html
// x = (q + (q^2 + (r-p^2)^3)^(1/2))^(1/3) + (q-(q^2+(r-p^2)^3)^(1/2))^(1/3) + p
// p = -b/(3a)
// q = p^3 + (b c - 3 a d)/(6 a^2)
// r = c / (3 a)
// Replace floating-point approximation to zero with integer 0.
0. <-> 0
// Some simplifying rules that actually aren't appropriate if you're
// tracking units. These are not really valid because 0 feet != 0 days
// and 0 feet + 0 is not units-correct.
// TODO: FIX THIS! We need a pattern that matches units with magnitude
// of zero.
0 _x <-> 0
// 0 + _x <-> _x
1 _x <-> _x
1^_x <-> 1
ln[e] <-> 1
ln[1] <-> 0
log[10] <-> 1
log[1] <-> 0
log[_a, _b] <-> ln[_a] / ln[_b]
// This transforms rules in terms of log base 10 into equations of
// natural log. This makes a lot of different types of equations more
// readily solved by already-existing rules: for example, LambertW rules,
// (see powerTransformations.frink)
// and eliminates the need to rewrite all of these rules in multiple forms.
log[_a] <-> ln[_a] / ln[10]
// Simplifying rule
e^ln[_x] <-> _x
// Simplifying rule
e^(_a ln[_b]) <-> _b^_a
// Simplifying rule
ln[_a ^ _b] <-> _b ln[_a]
// Simplifying rule
log[_a ^ _b] <-> _b log[_a]
// Exponentiate out parts. This is only valid if the exponent is an integer
(_a _b)^_c :: isInteger[_c] <-> _a^_c _b^_c
// Distribute (to often clarify and simplify)
// (Note: this is often disadvantageous when using
// interval arguments as intervals are subdistributive and the result
// may be wider.)
_a (_c + _d) <-> _a _c + _a _d
// Combine coefficients of x;
// This may cause loops with the above expression.
// _a _x + _b _x + (_c:0) <-> (_a + _b) _x + _c
// (_a + _b)^_k :: isInteger[_k] AND _k >= 2 <-> (_a^2 + 2 _a _b + _b^2)(_a + _b)^(_k-2)
// Sinc function
sinc[_x] <-> _x == 0 ? 1 : sin[_x]/_x
sinc[0] <-> 1
// Simplify trinary conditionals
_x == _x <-> true
true ? _x : _y <-> _x
false ? _x : _y <-> _y
}
"solvingTransformations.frink included ok!"
Download or view solvingTransformations.frink in plain text format
This is a program written in the programming language Frink.
For more information, view the Frink
Documentation or see More Sample Frink Programs.
Alan Eliasen was born 19966 days, 7 hours, 49 minutes ago.