solvingTransformations.frink

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 19944 days, 11 hours, 58 minutes ago.