alias factorise { unset %factr.* var %factr.input = $1- if ($+(*,$chr(94),*) iswm $1-) { var %factr.orgstring = $replace($1-,$chr(178),^2,$chr(179),^3,pi,$pi) var %factr.string $replace(%factr.orgstring,$chr(41),CBKT,$chr(40),OBKT) noop $regex(%factr.string,/([[:alpha:]])((CBKT)+)?(\^)/g) var %factr.char = $regml(1) set %factr.repl %factr.string var %i = 1 ; CHECK IF IT NEEDS TO PERFORM ANY SIN/TAN/COS/SQRT STUFF while (*sin* iswm %factr.repl || *tan* iswm %factr.repl || *cos* iswm %factr.repl || *sq* iswm %factr.repl) { set %factr.repl $regsubex(%factr.repl,/(?:asin(e)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$asin(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:atan(gent)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$atan(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:acos(ine)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$acos(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:sin(e)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$sin(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:tan(gent)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$tan(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:cos(ine)?)(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$cos(\t).deg) set %factr.repl $regsubex(%factr.repl,/(?:sq(?:r)?(?:t|oot)|square(?:rt|root))(?:OBKT)?([\.0-9]+)(?:CBKT)?/g,$sqrt(\t)) inc %i } set %factr.finrepl $replace(%factr.repl,OBKT,$chr(40),CBKT,$chr(41),$+($chr(43),$chr(45)),$chr(45),$+($chr(45),$chr(43)),$chr(43),$+($chr(43),$chr(43)),$chr(43),$+($chr(45),$chr(45)),$chr(43)) ; ALL IN RIGHT SYNTAX set %factr.rearr %factr.finrepl set %factr.chtimes $calc($numtok($replace(%factr.finrepl,$chr(45),$chr(43)),43)) var %e = 1 while (%e <= %factr.chtimes) { set %factr.rearr $regsubex(%factr.rearr,/(\+|\-|^|\=) $+ %factr.char $+ (\+|\-|\=|$)/g,\1 $+ 1 $+ %factr.char $+ ^1\2) set %factr.rearr $regsubex(%factr.rearr,/(\+|\-|^|\=)([\.0-9]+) $+ %factr.char $+ (\+|\-|\=|$)/g,\1 $+ \2 $+ %factr.char $+ ^1\3) set %factr.rearr $regsubex(%factr.rearr,/(\+|\-|^|\=) $+ %factr.char $+ \^([\.0-9]+)(\+|\-|\=|$)/g,\1 $+ 1 $+ %factr.char $+ ^\2\3) set %factr.rearr $regsubex(%factr.rearr,/(\+|\-|^|\=)([\.0-9]+)(\+|\-|\=|$)/g,\1\2 $+ %factr.char $+ ^0\3) inc %e } $iif($left(%factr.rearr,1) != $chr(43) && $left(%factr.rearr,1) != $chr(45),set %factr.rearr $+($chr(43),%factr.rearr)) ; CHUCK STUFF ON RIGHT OF = TO LEFT if ($+(*,$chr(61),*) iswm %factr.rearr) { tokenize 61 %factr.rearr set %factr.aftreq $iif($left($2,1) != $chr(43) && $left($2,1) != $chr(45),$+($chr(43),$2),$2) var %factr.rearr = $1 $+ $replace(%factr.aftreq,$chr(43),$chr(167),$chr(45),$chr(43),$chr(167),$chr(45)) } ; WORK OUT NUMBER OF COEFFS set %factr.degs $gettok($sorttok($regsubex(%factr.rearr,/(\+|\-)([\.0-9]+) $+ %factr.char $+ \^/g,$chr(126)),126,nr),1,126) ; COLLECT TERMS var %q = 0 while (%q <= %factr.degs) { %factr.addterms = $regex(%factr.rearr,/(\+|\-)([\.0-9]+) $+ %factr.char $+ \^ $+ %q $+ /g) var %r = 1 $iif(!$calc(!%factr.addterms), set %factr. [ $+ [ %q ] ] 0) while (%r <= $calc(%factr.addterms * 2 - 1)) { set %factr. [ $+ [ %q ] ] $calc(%factr. [ $+ [ %q ] ] $regml(%r) $regml($calc(%r + 1))) inc %r 2 } inc %q } ; DIVIDE ONE BY THE OTHER AND LOOP set %factr.origdegs %factr.degs var %z = 0 set %factr.repall 1 while (%z < %factr.origdegs && %factr.repall == 1) { if (%factr.repeat == 1) { set %factr.t [ $+ [ $calc(%factr.degs - 1) ] ] %factr. [ $+ [ %factr.degs ] ] var %y = 0 while (%y < $calc(%factr.degs - 1)) { set %factr.t [ $+ [ $calc(%factr.degs - 2 - %y) ] ] $calc(%factr. [ $+ [ $calc(%factr.degs - 1 - %y) ] ] + %factr.t [ $+ [ $calc(%factr.degs - 1 - %y) ] ] * %factr.root) inc %y } unset %factr. [ $+ [ %factr.degs ] ] dec %factr.degs ; GIVE BACK ORIG NAMES var %y = 0 while (%y <= %factr.degs) { set %factr. [ $+ [ %y ] ] %factr.t [ $+ [ %y ] ] inc %y } } ; CREATE EQUATION unset %factr.fineq unset %factr.nextloop var %q = %factr.degs while ($calc(%q + 1) > 0) { set %factr.fineq %factr.fineq $+ $iif($left(%factr. [ $+ [ %q ] ],1) != $chr(45),$chr(43)) $+ %factr. [ $+ [ %q ] ] $+ %factr.char $+ ^ $+ %q $+ $chr(41) set %factr.nextloop $iif(%factr. [ $+ [ %q ] ] != 0,$+($iif(%q == %factr.degs,$chr(40)),%factr.nextloop,$iif($left(%factr. [ $+ [ %q ] ],1) != $chr(45),$chr(43)),%factr. [ $+ [ %q ] ],%factr.char,^,%q,$iif(%q == 0,$chr(41))),%factr.nextloop) set %factr.nextloop $replace($remove(%factr.nextloop,$+(%factr.char,^,0)),$+(1,%factr.char),%factr.char,$+($chr(40),+),$chr(40)) dec %q } ; CHANGE %factr.0 TO POSITIVE $iif($left(%factr.0,1) == $chr(45),set %factr.0 $right(%factr.0,-1)) ; LIST ALL NUMERATORS unset %factr.numtors var %n = 1 while (%n <= $calc(%factr.0 / 2)) { if (%n // %factr.0) { set %factr.numtors %factr.numtors $+ $chr(44) $+ %n } inc %n } set %factr.numtors %factr.numtors $+ $chr(44) $+ %factr.0 ; LIST ALL DENOMINATORS unset %factr.denumtors var %n = 1 while (%n <= $calc(%factr. [ $+ [ %factr.degs ] ] / 2)) { if (%n // %factr. [ $+ [ %factr.degs ] ]) { set %factr.denumtors %factr.denumtors $+ $chr(44) $+ %n } inc %n } set %factr.denumtors %factr.denumtors $+ $chr(44) $+ %factr. [ $+ [ %factr.degs ] ] ; LOOP THROUGH POSS SOLUTIONS UNTIL FACTOR set %factr.sign $chr(43) set %factr.attmpt var %r = 1 set %factr.repall 2 while (%r <= $numtok(%factr.denumtors,44)) { tokenize 44 %factr.denumtors set %factr.denumatt $ [ $+ [ %r ] ] var %n = 1 while (%n <= $numtok(%factr.numtors,44 && %factr.attmpt != 0)) { tokenize 44 %factr.numtors set %factr.numatt $ [ $+ [ %n ] ] inc %n var %q = 0 while (%q < 1 && %factr.attmpt != 0) { set %factr.attmpt $calc($replace(%factr.fineq,%factr.char,$+(*,$chr(40),%factr.sign,$chr(40),$+($chr(40),%factr.numatt,$chr(47),%factr.denumatt,$chr(41),$chr(41))))) ; ON CORRECT FACTOR if (%factr.attmpt == 0 && %factr.denumatt != 0 && %factr.numatt != 0) { set %factr.fctised $+(%factr.fctised,$chr(40),%factr.char,$replace(%factr.sign,$chr(43),$chr(167),$chr(45),$chr(43),$chr(167),$chr(45)),%factr.numatt,$chr(47),%factr.denumatt,$chr(41)) set %factr.root $+(%factr.sign,%factr.numatt,$chr(47),%factr.denumatt) set %factr.repeat 1 set %factr.repall 1 } if (%factr.sign == $chr(45)) { set %factr.sign $chr(43) inc %q } else { set %factr.sign $chr(45) } } } inc %r } inc %z } ; CHANGE FORMAT OF OUTPUT $iif(*/1* iswm %factr.fctised || *^1* iswm %factr.fctised, set %factr.fctised $remove(%factr.fctised,/1,^1)) set %factr.fctised $regsubex(%factr.fctised,/ $+ %factr.char $+ (\+|\-)([\.0-9]+)(\/)(\-)?([\.0-9]+)/g,\4 $+ %factr.char $+ \1\2) if ($count(%factr.fctised,$chr(40)) => 1 && $count(%factr.fctised,$chr(40)) < %factr.origdegs) { set %factr.fctised $+(%factr.fctised,%factr.nextloop) } if (!%factr.fctised) { set %factr.fctised $remove(%factr.fineq,$+(%factr.char,^0),^1,$chr(41)) set %factr.fctised $iif($left(%factr.fctised,1) == $chr(43),$right(%factr.fctised,-1),%factr.fctised) } return %factr.fctised } }