Mine

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 
  } 
}