systemSolver.frink

View or download systemSolver.frink in plain text format


// Attempt to solve a system of equations.

use solvingTransformations.frink
showApproximations[false]
symbolicMode[true]

solveSystem[equations, solveForString] :=
{
   eqArray = new array
   size = length[equations]
   allUnknowns = new set
   for i=0 to size-1
   {
      syms = getSymbols[parseToExpression[equations@i]]
      equation = equations@i
//      println["Equation is $equation"]
//      println["Symbols are $syms"]
      eqArray.push[ [equation, syms] ]
//      println["eqArray is $eqArray"]
      allUnknowns = union[allUnknowns, syms]
//      println["allUnknowns is $allUnknowns"]
   }

//   println["All unknowns: $allUnknowns"]
   // Sort equations by number of unknowns (fewest first)
   sort[eqArray, {|a,b| length[a@1] <=> length[b@1]}]

   res = solveParts[eqArray, solveForString]
   res = eliminateDuplicates[res]
   res = eliminateOverconstrained[res]
//   res = eliminateSelfReferential[res]
   return res
}

// This is a recursive internal method to solve for other unknowns.
solveParts[eqArray, solveForString] :=
{
   results = new array
   size = length[eqArray]
   for i=0 to size-1
   {
      [eq, unknowns] = eqArray@i
      if unknowns.contains[solveForString]
      {
         oe = parseToExpression[eq]
         equation = parseToExpression["solve[$eq, $solveForString]"]
         solvedEq = transformExpression["solving", equation]
         results.push[solvedEq]
         println["Result is $solvedEq"]
         otherEqs = eqArray.shallowCopy[]
         otherEqs.remove[i]

         otherSize = length[otherEqs]
         for unknown = unknowns
         {
            pUnknown = parseToExpression[unknown]
            if (unknown != solveForString)
               for j=0 to otherSize-1
               {
                  res2 = solveParts[otherEqs, unknown]
//                  println["Unknown is $unknown"]
//                  println["Res2 is $res2"]
                  for respart = res2
                  {
//                     println["Replacing in $solvedEq, $pUnknown becomes " + child[respart,1]]
                    // TODO:  Replace solving with simplification rules.
                     r = transformExpression["solving",substituteExpression[solvedEq, pUnknown, child[respart,1]]]
//                     println["  Result: $r"]
                     results.push[r]
                  }
               }
         }
      }
   }
   return flatten[results]
}


eliminateDuplicates[eqArray] :=
{
   i=0
   j=1
   while (i<length[eqArray])
   {
      ie = eqArray@i
      while (j<length[eqArray])
      {
         if structureEquals[ie, eqArray@j]
         {
//            println["Removing duplicate " + eqArray@j]
            eqArray.remove[j]   // Don't advance index in this case
         } else
         j=j+1
      }
      i=i+1
      j=i+1
   }
   return eqArray
}

// This function eliminates overconstrained equations.  For example, a system
// containing the solutions a===1/2 c r  and  a===c d^-1 r^2  is
// overconstrained because a value can always be obtained with the first
// equation.  The second is not necessary.
eliminateOverconstrained[eqArray] :=
{
   size = length[eqArray]
   unknowns = new array
   for i = 0 to size-1
      unknowns@i = getSymbols[child[eqArray@i,1]]

   res = new array

   isProper = true
   ILOOP:
   for i=0 to size-1
   {
      overconstrained = false
      j = 0
      do
      {
         overconstrained = isProperSubset[unknowns@j, unknowns@i]
         if (overconstrained)
            println[eqArray@j + " is a proper subset of " + eqArray@i]
         j=j+1
      } while (j < size) && ! overconstrained

      if (! overconstrained)
         res.push[eqArray@i]  // If we got here, no j is a proper subset of i.
   }

   return res
}


symbolicMode[true]
//println[join["\n",solveSystem[["d === 2 r", "c === pi d", "a === pi r^2", "e===f", "g===h"], "r"]]]

// See http://answers.yahoo.com/question/index?qid=20091120001614AAInec3
// TODO:
//   eliminate pAprime and pAB, as those are what we want to solve for.
println[join["\n",solveSystem[["pAB === pBA pA / pB", "pA === 1 - pAprime", "pAB === ( pBA pA ) / ( pBA pA + pBAprime pAprime ) "], "pB"]]]


View or download systemSolver.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 17836 days, 23 hours, 38 minutes ago.