/*REXX program  demonstrates  (with displays)  a method of   parametric polymorphism.   */
call newRoot  1.00, 3                            /*new root,  and also indicate 3 stems.*/
                                                 /* [↓]  no need to label the stems.    */
call addStem  1.10                               /*a new stem  and  its initial value.  */
call addStem  1.11                               /*"  "    "    "    "     "      "     */
call addStem  1.12                               /*"  "    "    "    "     "      "     */
call addStem  1.20                               /*"  "    "    "    "     "      "     */
call addStem  1.21                               /*"  "    "    "    "     "      "     */
call addStem  1.22                               /*"  "    "    "    "     "      "     */
                       call sayNodes             /*display some nicely formatted values.*/
call modRoot  50                                 /*modRoot will add fifty to all stems. */
                       call sayNodes             /*display some nicely formatted values.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
addStem:  nodes= nodes + 1;   do j=1  for stems;   root.nodes.j= arg(1);   end;     return
newRoot:  parse arg @,stems; nodes= -1; call addStem copies('═',9); call addStem @; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
modRoot:  arg #;  do    j=1  for nodes           /*traipse through all the defined nodes*/
                     do k=1  for stems           /*add bias ──►───────────────────────┐ */
                     if datatype(root.j.k, 'N')  then root.j.k= root.j.k + #   /* ◄───┘ */
                     end   /*k*/                 /* [↑]  add  if  stem value is numeric.*/
                  end      /*j*/
          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
sayNodes: w= 9;   do    j=0  to  nodes;  _=      /*ensure each of the nodes gets shown. */
                     do k=1  for stems;  _= _ center(root.j.k, w)  /*concatenate a node.*/
                     end   /*k*/
                  $= word('node='j,  1 + (j<1) ) /*define a label for this line's output*/
                  say center($, w)  substr(_, 2) /*ignore 1st (leading) blank which was */
                  end      /*j*/                 /* [↑]         caused by concatenation.*/
          say                                    /*show a blank line to separate outputs*/
          return


struct TreeNode<T> {
    value: T,
    left: Option<Box<TreeNode<T>>>,
    right: Option<Box<TreeNode<T>>>,
}

impl <T> TreeNode<T> {
    fn my_map<U,F>(&self, f: &F) -> TreeNode<U> where
            F: Fn(&T) -> U {
        TreeNode {
            value: f(&self.value),
            left: match self.left {
                None => None,
                Some(ref n) => Some(Box::new(n.my_map(f))),
            },
            right: match self.right {
                None => None,
                Some(ref n) => Some(Box::new(n.my_map(f))),
            },
        }
    }
}

fn main() {
    let root = TreeNode {
        value: 3,
        left: Some(Box::new(TreeNode {
            value: 55,
            left: None,
            right: None,
        })),
        right: Some(Box::new(TreeNode {
            value: 234,
            left: Some(Box::new(TreeNode {
                value: 0,
                left: None,
                right: None,
            })),
            right: None,
        })),
    };
    root.my_map(&|x| { println!("{}" , x)});
    println!("---------------");
    let new_root = root.my_map(&|x| *x as f64 * 333.333f64);
    new_root.my_map(&|x| { println!("{}" , x) });
}


case class Tree[+A](value: A, left: Option[Tree[A]], right: Option[Tree[A]]) {
  def map[B](f: A => B): Tree[B] =
    Tree(f(value), left map (_.map(f)), right map (_.map(f)))
}


$ include "seed7_05.s7i";

const func type: container (in type: elemType) is func
  result
    var type: container is void;
  begin
    container := array elemType;

    global

      const func container: map (in container: aContainer,
          inout elemType: aVariable, ref func elemType: aFunc) is func
        result
          var container: mapResult is container.value;
        begin
          for aVariable range aContainer do
            mapResult &:= aFunc;
          end for;
        end func;

    end global;
  end func;

const type: intContainer is container(integer);
var intContainer: container1 is [] (1, 2, 4, 6, 10, 12, 16, 18, 22);
var intContainer: container2 is 0 times 0;

const proc: main is func
  local
    var integer: num is 0;
  begin
    container2 := map(container1, num, num + 1);
    for num range container2 do
      write(num <& " ");
    end for;
    writeln;
  end func;


datatype 'a tree = Empty | Node of 'a * 'a tree * 'a tree

(** val map_tree = fn : ('a -> 'b) -> 'a tree -> 'b tree *)
fun map_tree f Empty = Empty
  | map_tree f (Node (x,l,r)) = Node (f x, map_tree f l, map_tree f r)


class Tree<T> {
  var value: T?
  var left: Tree<T>?
  var right: Tree<T>?

  func replaceAll(value: T?) {
    self.value = value
    left?.replaceAll(value)
    right?.replaceAll(value)
  }
}


binary_tree_of "node-type" = "node-type"%hhhhWZAZ


Class BinaryTree(Of T)
    ReadOnly Property Left As BinaryTree(Of T)
    ReadOnly Property Right As BinaryTree(Of T)
    ReadOnly Property Value As T

    Sub New(value As T, Optional left As BinaryTree(Of T) = Nothing, Optional right As BinaryTree(Of T) = Nothing)
        Me.Value = value
        Me.Left = left
        Me.Right = right
    End Sub

    Function Map(Of U)(f As Func(Of T, U)) As BinaryTree(Of U)
        Return New BinaryTree(Of U)(f(Me.Value), Me.Left?.Map(f), Me.Right?.Map(f))
    End Function

    Overrides Function ToString() As String
        Dim sb As New Text.StringBuilder()
        Me.ToString(sb, 0)
        Return sb.ToString()
    End Function

    Private Overloads Sub ToString(sb As Text.StringBuilder, depth As Integer)
        sb.Append(New String(ChrW(AscW(vbTab)), depth))
        sb.AppendLine(Me.Value?.ToString())
        Me.Left?.ToString(sb, depth + 1)
        Me.Right?.ToString(sb, depth + 1)
    End Sub
End Class

Module Program
    Sub Main()
        Dim b As New BinaryTree(Of Integer)(6, New BinaryTree(Of Integer)(5), New BinaryTree(Of Integer)(7))
        Dim b2 As BinaryTree(Of Double) = b.Map(Function(x) x * 0.5)

        Console.WriteLine(b)
        Console.WriteLine(b2)
    End Sub
End Module


domains
   tree{Type} = branch(tree{Type} Left, tree{Type} Right); leaf(Type Value).

class predicates
   treewalk : (tree{X},function{X,Y}) -> tree{Y} procedure (i,i).

clauses
   treewalk(branch(Left,Right),Func) = branch(NewLeft,NewRight) :-
        NewLeft = treewalk(Left,Func), NewRight = treewalk(Right,Func).

   treewalk(leaf(Value),Func) = leaf(X) :-
        X = Func(Value).

   run():-
       init(),
       X = branch(leaf(2), branch(leaf(3),leaf(4))),
       Y = treewalk(X,addone),
       write(Y),
       succeed().


class BinaryTree {
    construct new(T, value) {
        if (!(T is Class)) Fiber.abort ("T must be a class.")
        if (value.type != T) Fiber.abort("Value must be of type T.")
        _kind = T
        _value = value
        _left = null
        _right = null
    }

    // constructor overload to enable kind to be inferred from type of value
    static new (value) { new(value.type, value) }

    kind  { _kind }
    value { _value}
    value=(v) {
        if (v.type != _kind) Fiber.abort("Value must be of type %(_kind)")
        _value = v
    }

    left  { _left }
    right { _right }
    left=(b) {
        if (b.type != BinaryTree || b.kind != _kind) {
            Fiber.abort("Argument must be a BinaryTree of type %(_kind)")
        }
        _left = b
    }
    right=(b) {
        if (b.type != BinaryTree || b.kind != _kind) {
            Fiber.abort("Argument must be a BinaryTree of type %(_kind)")
        }
        _right = b
    }

    map(f) {
        var tree = BinaryTree.new(f.call(_value))
        if (_left) tree.left = left.map(f)
        if (_right) tree.right = right.map(f)
        return tree
    }

    showTopThree() { "(%(left.value), %(value), %(right.value))" }
}

var b    = BinaryTree.new(6)
b.left   = BinaryTree.new(5)
b.right  = BinaryTree.new(7)
System.print(b.showTopThree())

var b2   = b.map{ |i| i * 10 }
System.print(b2.showTopThree())
b2.value = "six" // generates an error because "six" is not a Num


generic
   type Number is private;
   Zero : Number;
   One  : Number;
   Two  : Number;
   with function Image (X : Number) return String is <>;
   with function "+"   (X, Y : Number) return Number is <>;
   with function "/"   (X, Y : Number) return Number is <>;
   with function "mod" (X, Y : Number) return Number is <>;
   with function ">="  (X, Y : Number) return Boolean is <>;
package Prime_Numbers is
   type Number_List is array (Positive range <>) of Number;

   procedure Put (List : Number_List);

   task type Calculate_Factors is
      entry Start (The_Number : in Number);
      entry Get_Size (Size : out Natural);
      entry Get_Result (List : out Number_List);
   end Calculate_Factors;

end Prime_Numbers;


#include <stdio.h>
#include <omp.h>

int main()
{
        int data[] = {12757923, 12878611, 12878893, 12757923, 15808973, 15780709, 197622519};
        int largest, largest_factor = 0;

        omp_set_num_threads(4);
        /* "omp parallel for" turns the for loop multithreaded by making each thread
         * iterating only a part of the loop variable, in this case i; variables declared
         * as "shared" will be implicitly locked on access
         */
        #pragma omp parallel for shared(largest_factor, largest)
        for (int i = 0; i < 7; i++) {
                int p, n = data[i];

                for (p = 3; p * p <= n && n % p; p += 2);
                if (p * p > n) p = n;
                if (p > largest_factor) {
                        largest_factor = p;
                        largest = n;
                        printf("thread %d: found larger: %d of %d\n",
                                omp_get_thread_num(), p, n);
                } else {
                        printf("thread %d: not larger:   %d of %d\n",
                                omp_get_thread_num(), p, n);
                }
        }

        printf("Largest factor: %d of %d\n", largest_factor, largest);
        return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    public static List<int> PrimeFactors(int number)
    {
        var primes = new List<int>();
        for (int div = 2; div <= number; div++)
        {
            while (number % div == 0)
            {
                primes.Add(div);
                number = number / div;
            }
        }
        return primes;
    }

    static void Main(string[] args)
    {
        int[] n = { 12757923, 12878611, 12757923, 15808973, 15780709, 197622519 };
        // Calculate each of those numbers' prime factors, in parallel
        var factors = n.AsParallel().Select(PrimeFactors).ToList();
        // Make a new list showing the smallest factor for each
        var smallestFactors = factors.Select(thisNumbersFactors => thisNumbersFactors.Min()).ToList();
        // Find the index that corresponds with the largest of those factors
        int biggestFactor = smallestFactors.Max();
        int whatIndexIsThat = smallestFactors.IndexOf(biggestFactor);
        Console.WriteLine("{0} has the largest minimum prime factor: {1}", n[whatIndexIsThat], biggestFactor);
        Console.WriteLine(string.Join(" ", factors[whatIndexIsThat]));
    }
}


#include <iostream>
#include <iterator>
#include <vector>
#include <ppl.h> // MSVC++
#include <concurrent_vector.h> // MSVC++

struct Factors
{
    int number;
    std::vector<int> primes;
};

const int data[] =
{
    12757923, 12878611, 12878893, 12757923, 15808973, 15780709, 197622519
};

int main()
{
    // concurrency-safe container replaces std::vector<>
    Concurrency::concurrent_vector<Factors> results;

    // parallel algorithm replaces std::for_each()
    Concurrency::parallel_for_each(std::begin(data), std::end(data), [&](int n)
    {
        Factors factors;
        factors.number = n;
        for (int f = 2; n > 1; ++f)
        {
            while (n % f == 0)
            {
                factors.primes.push_back(f);
                n /= f;
            }
        }
        results.push_back(factors); // add factorization to results
    });
    // end of parallel calculations

    // find largest minimal prime factor in results
    auto max = std::max_element(results.begin(), results.end(), [](const Factors &a, const Factors &b)
    {
        return a.primes.front() < b.primes.front();
    });

    // print number(s) and factorization
    std::for_each(results.begin(), results.end(), [&](const Factors &f)
    {
        if (f.primes.front() == max->primes.front())
        {
            std::cout << f.number << " = [ ";
            std::copy(f.primes.begin(), f.primes.end(), std::ostream_iterator<int>(std::cout, " "));
            std::cout << "]\n";
        }
    });
    return 0;
}


(use '[clojure.contrib.lazy-seqs :only [primes]])

(defn lpf [n]
  [n (or (last
          (for [p (take-while #(<= (* % %) n) primes)
                :when (zero? (rem n p))]
            p))
         1)])

(->> (range 2 100000)
     (pmap lpf)
     (apply max-key second)
     println
     time)


(ql:quickload '(lparallel))

(setf lparallel:*kernel* (lparallel:make-kernel 4)) ;; Configure for your system.

(defun factor (n &optional (acc '()))
  (when (> n 1)
    (loop with max-d = (isqrt n)
       for d = 2 then (if (evenp d) (1+ d) (+ d 2)) do
         (cond ((> d max-d) (return (cons (list n 1) acc)))
               ((zerop (rem n d))
                (return (factor (truncate n d)
                                (if (eq d (caar acc))
                                    (cons
                                     (list (caar acc) (1+ (cadar acc)))
                                     (cdr acc))
                                    (cons (list d 1) acc)))))))))

(defun max-minimum-factor (numbers)
  (lparallel:pmap-reduce
   (lambda (n) (cons n (apply #'min (mapcar #'car (factor n)))))
   (lambda (a b) (if (> (cdr a) (cdr b)) a b))
   numbers))

(defun print-max-factor (pair)
  (format t "~a has the largest minimum factor ~a~%" (car pair) (cdr pair)))


ulong[] decompose(ulong n) pure nothrow {
    typeof(return) result;
    for (ulong i = 2; n >= i * i; i++)
        for (; n % i == 0; n /= i)
            result ~= i;
    if (n != 1)
        result ~= n;
    return result;
}

void main() {
    import std.stdio, std.algorithm, std.parallelism, std.typecons;

    immutable ulong[] data = [
        2UL^^59-1, 2UL^^59-1, 2UL^^59-1, 112_272_537_195_293UL,
        115_284_584_522_153, 115_280_098_190_773,
        115_797_840_077_099, 112_582_718_962_171,
        112_272_537_095_293, 1_099_726_829_285_419];

    //auto factors = taskPool.amap!(n => tuple(decompose(n), n))(data);
    //static enum genPair = (ulong n) pure => tuple(decompose(n), n);
    static genPair(ulong n) pure { return tuple(decompose(n), n); }
    auto factors = taskPool.amap!genPair(data);

    auto pairs = factors.map!(p => tuple(p[0].reduce!min, p[1]));
    writeln("N. with largest min factor: ", pairs.reduce!max[1]);
}


program Parallel_calculations;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Threading,
  Velthuis.BigIntegers;

function IsPrime(n: BigInteger): Boolean;
var
  i: BigInteger;
begin
  if n <= 1 then
    exit(False);

  i := 2;
  while i < BigInteger.Sqrt(n) do
  begin
    if n mod i = 0 then
      exit(False);
    inc(i);
  end;

  Result := True;
end;

function GetPrimes(n: BigInteger): TArray<BigInteger>;
var
  divisor, next, rest: BigInteger;
begin
  divisor := 2;
  next := 3;
  rest := n;
  while (rest <> 1) do
  begin
    while (rest mod divisor = 0) do
    begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := divisor;
      rest := rest div divisor;
    end;
    divisor := next;
    next := next + 2;
  end;
end;

function Min(l: TArray<BigInteger>): BigInteger;
begin
  if Length(l) = 0 then
    exit(0);

  Result := l[0];
  for var v in l do
    if v < result then
      Result := v;
end;

const
  n: array of Uint64 = [12757923, 12878611, 12757923, 15808973, 15780709, 197622519];

var
  m: BigInteger;
  len, j, i: Uint64;
  l: TArray<TArray<BigInteger>>;

begin
  j := 0;
  m := 0;
  len := length(n);
  SetLength(l, len);

  TParallel.for (0, len - 1,
    procedure(i: Integer)
    begin
      l[i] := getPrimes(n[i]);
    end);

  for i := 0 to len - 1 do
  begin
    var _min := Min(l[i]);
    if _min > m then
    begin
      m := _min;
      j := i;
    end;
  end;

  writeln('Number ', n[j].ToString, ' has largest minimal factor:');
  for var v in l[j] do
    write(' ', v.ToString);

  readln;
end.


-module( parallel_calculations ).

-export( [fun_results/2, task/0] ).

fun_results( Fun, Datas ) ->
        My_pid = erlang:self(),
	Pids = [fun_spawn( Fun, X, My_pid ) || X <- Datas],
	[fun_receive(X) || X <- Pids].

task() ->
    Numbers = [12757923, 12878611, 12757923, 15808973, 15780709, 197622519],
    Results = fun_results( fun factors/1, Numbers ),
    Min_results = [lists:min(X) || X <- Results],
    {_Max_min_factor, Number} = lists:max( lists:zip(Min_results, Numbers) ),
    {Number, Factors} = lists:keyfind( Number, 1, lists:zip(Numbers, Results) ),
    io:fwrite( "~p has largest minimal factor among its prime factors ~p~n", [Number, Factors] ).

factors(N) -> factors(N,2,[]).

factors(1,_,Acc) -> Acc;
factors(N,K,Acc) when N rem K == 0 -> factors(N div K,K, [K|Acc]);
factors(N,K,Acc) -> factors(N,K+1,Acc).

fun_receive( Pid ) ->
        receive
        {ok, Result, Pid} -> Result;
	{Type, Error, Pid} -> erlang:Type( Error )
        end.

fun_spawn( Fun, Data, My_pid ) ->
        erlang:spawn( fun() ->
                Result = try
                       {ok, Fun(Data), erlang:self()}

		       catch
	               Type:Error -> {Type, Error, erlang:self()}

		       end,
	        My_pid ! Result
        end ).


open System
open PrimeDecomp // Has the decompose function from the Prime decomposition task

let data = [112272537195293L; 112582718962171L; 112272537095293L; 115280098190773L; 115797840077099L; 1099726829285419L]
let decomp num = decompose num 2L

let largestMinPrimeFactor (numbers: int64 list) =
    let decompDetails = Async.Parallel [ for n in numbers -> async { return n, decomp n } ] // Compute the number and its prime decomposition list
                        |> Async.RunSynchronously                                           // Start and wait for all parallel computations to complete.
                        |> Array.sortBy (snd >> List.min >> (~-))                           // Sort in descending order, based on the min prime decomp number.

    decompDetails.[0]

let showLargestMinPrimeFactor numbers =
    let number, primeList = largestMinPrimeFactor numbers
    printf "Number %d has largest minimal factor:\n    " number
    List.iter (printf "%d ") primeList

showLargestMinPrimeFactor data


USING: io kernel fry locals sequences arrays math.primes.factors math.parser channels threads prettyprint ;
IN: <filename>

:: map-parallel ( seq quot -- newseq )
    <channel> :> ch
    seq [ '[ _ quot call ch to ] "factors" spawn ] { } map-as
    dup length [ ch from ] replicate nip ;

{ 576460752303423487 576460752303423487
  576460752303423487 112272537195293
  115284584522153 115280098190773
  115797840077099 112582718962171
  112272537095293 1099726829285419 }
dup [ factors ] map-parallel
dup [ infimum ] map dup supremum
swap index swap dupd nth -rot swap nth
"Number with largest min. factor is " swap number>string append
", with factors: " append write .


program Primes

    use ISO_FORTRAN_ENV

    implicit none

    integer(int64), dimension(7) :: data = (/2099726827, 15780709, 1122725370, 15808973, 576460741, 12878611, 12757923/)
    integer(int64), dimension(100) :: outprimes
    integer(int64) :: largest_factor = 0, largest = 0, minim = 0, val = 0
    integer(int16) :: count = 0, OMP_GET_THREAD_NUM

    call omp_set_num_threads(4);
    !$omp parallel do private(val,outprimes,count) shared(data,largest_factor,largest)
    do val = 1, 7
        outprimes = 0
        call find_factors(data(val), outprimes, count)
        minim = minval(outprimes(1:count))
        if (minim > largest_factor) then
            largest_factor = minim
            largest = data(val)
        end if
        write(*, fmt = '(A7,i0,A2,i12,100i12)') 'Thread ', OMP_GET_THREAD_NUM(), ': ', data(val), outprimes(1:count)
    end do
    !$omp end parallel do

    write(*, fmt = '(i0,A26,i0)') largest, ' have the Largest factor: ', largest_factor

    return

contains

    subroutine find_factors(n, d, count)
        integer(int64), intent(in) :: n
        integer(int64), dimension(:), intent(out) :: d
        integer(int16), intent(out) :: count
        integer(int16) :: i
        integer(int64) :: div, next, rest

        i = 1
        div = 2; next = 3; rest = n

        do while (rest /= 1)
            do while (mod(rest, div) == 0)
                d(i) = div
                i = i + 1
                rest = rest / div
            end do
            div = next
            next = next + 2
        end do
        count = i - 1
    end subroutine find_factors

end program Primes


package main

import (
    "fmt"
    "math/big"
)

// collection of numbers.  A slice is used for the collection.
// The elements are big integers, since that's what the function Primes
// uses (as was specified by the Prime decomposition task.)
var numbers = []*big.Int{
    big.NewInt(12757923),
    big.NewInt(12878611),
    big.NewInt(12878893),
    big.NewInt(12757923),
    big.NewInt(15808973),
    big.NewInt(15780709),
}

// main just calls the function specified by the task description and
// prints results.  note it allows for multiple numbers with the largest
// minimal factor.  the task didn't specify to handle this, but obviously
// it's possible.
func main() {
    rs := lmf(numbers)
    fmt.Println("largest minimal factor:", rs[0].decomp[0])
    for _, r := range rs {
        fmt.Println(r.number, "->", r.decomp)
    }
}

// this type associates a number with it's prime decomposition.
// the type is neccessary so that they can be sent together over
// a Go channel, but it turns out to be convenient as well for
// the return type of lmf.
type result struct {
    number *big.Int
    decomp []*big.Int
}

// the function specified by the task description, "largest minimal factor."
func lmf([]*big.Int) []result {
    // construct result channel and start a goroutine to decompose each number.
    // goroutines run in parallel as CPU cores are available.
    rCh := make(chan result)
    for _, n := range numbers {
        go decomp(n, rCh)
    }

    // collect results.  <-rCh returns a single result from the result channel.
    // we know how many results to expect so code here collects exactly that
    // many results, and accumulates a list of those with the largest
    // minimal factor.
    rs := []result{<-rCh}
    for i := 1; i < len(numbers); i++ {
        switch r := <-rCh; r.decomp[0].Cmp(rs[0].decomp[0]) {
        case 1:
            rs = rs[:1]
            rs[0] = r
        case 0:
            rs = append(rs, r)
        }
    }
    return rs
}

// decomp is the function run as a goroutine.  multiple instances of this
// function will run concurrently, one for each number being decomposed.
// it acts as a driver for Primes, calling Primes as needed, packaging
// the result, and sending the packaged result on the channel.
// "as needed" turns out to mean sending Primes a copy of n, as Primes
// as written is destructive on its argument.
func decomp(n *big.Int, rCh chan result) {
    rCh <- result{n, Primes(new(big.Int).Set(n))}
}

// code below copied from Prime decomposition task
var (
    ZERO = big.NewInt(0)
    ONE  = big.NewInt(1)
)

func Primes(n *big.Int) []*big.Int {
    res := []*big.Int{}
    mod, div := new(big.Int), new(big.Int)
    for i := big.NewInt(2); i.Cmp(n) != 1; {
        div.DivMod(n, i, mod)
        for mod.Cmp(ZERO) == 0 {
            res = append(res, new(big.Int).Set(i))
            n.Set(div)
            div.DivMod(n, i, mod)
        }
        i.Add(i, ONE)
    }
    return res
}


import Control.Parallel.Strategies (parMap, rdeepseq)
import Control.DeepSeq (NFData)
import Data.List (maximumBy)
import Data.Function (on)

nums :: [Integer]
nums =
  [ 112272537195293
  , 112582718962171
  , 112272537095293
  , 115280098190773
  , 115797840077099
  , 1099726829285419
  ]

lowestFactor
  :: Integral a
  => a -> a -> a
lowestFactor s n
  | even n = 2
  | otherwise = head y
  where
    y =
      [ x
      | x <- [s .. ceiling . sqrt $ fromIntegral n] ++ [n]
      , n `rem` x == 0
      , odd x ]

primeFactors
  :: Integral a
  => a -> a -> [a]
primeFactors l n = f n l []
  where
    f n l xs =
      if n > 1
        then f (n `div` l) (lowestFactor (max l 3) (n `div` l)) (l : xs)
        else xs

minPrimes
  :: (Control.DeepSeq.NFData a, Integral a)
  => [a] -> (a, [a])
minPrimes ns =
  (\(x, y) -> (x, primeFactors y x)) $
  maximumBy (compare `on` snd) $ zip ns (parMap rdeepseq (lowestFactor 3) ns)

main :: IO ()
main = print $ minPrimes nums


procedure main(A)
    threads := []
    L := list(*A)
    every i := 1 to *A do put(threads, thread L[i] := primedecomp(A[i]))
    every wait(!threads)

    maxminF := L[maxminI := 1][1]
    every i := 2 to *L do if maxminF <:= L[i][1] then maxminI := i
    every writes((A[maxminI]||": ")|(!L[maxminI]||" ")|"\n")
end

procedure primedecomp(n)         #: return a list of factors
    every put(F := [], genfactors(n))
    return F
end

link factors


   numbers =. 12757923 12878611 12878893 12757923 15808973 15780709 197622519
   factors =. q:&.> parallelize 2 numbers NB. q: is parallelized here
   ind =. (i. >./) <./@> factors
   ind { numbers ;"_1 factors
┌────────┬───────────┐
│12878611│47 101 2713│
└────────┴───────────┘


import static java.lang.System.out;
import static java.util.Arrays.stream;
import static java.util.Comparator.comparing;

public interface ParallelCalculations {
    public static final long[] NUMBERS = {
      12757923,
      12878611,
      12878893,
      12757923,
      15808973,
      15780709,
      197622519
    };

    public static void main(String... arguments) {
      stream(NUMBERS)
        .unordered()
        .parallel()
        .mapToObj(ParallelCalculations::minimalPrimeFactor)
        .max(comparing(a -> a[0]))
        .ifPresent(res -> out.printf(
          "%d has the largest minimum prime factor: %d%n",
          res[1],
          res[0]
        ));
    }

    public static long[] minimalPrimeFactor(long n) {
      for (long i = 2; n >= i * i; i++) {
        if (n % i == 0) {
          return new long[]{i, n};
        }
      }
      return new long[]{n, n};
    }
}


var onmessage = function(event) {
    postMessage({"n" : event.data.n,
                 "factors" : factor(event.data.n),
                 "id" : event.data.id});
};

function factor(n) {
    var factors = [];
    for(p = 2; p <= n; p++) {
        if((n % p) == 0) {
            factors[factors.length] = p;
            n /= p;
        }
    }
    return factors;
}


// version 1.1.51

import java.util.stream.Collectors

/* returns the number itself, its smallest prime factor and all its prime factors */
fun primeFactorInfo(n: Int): Triple<Int, Int, List<Int>> {
    if (n <= 1) throw IllegalArgumentException("Number must be more than one")
    if (isPrime(n)) return Triple(n, n, listOf(n))
    val factors = mutableListOf<Int>()
    var factor = 2
    var nn = n
    while (true) {
        if (nn % factor == 0) {
            factors.add(factor)
            nn /= factor
            if (nn == 1) return Triple(n, factors.min()!!, factors)
            if (isPrime(nn)) factor = nn
        }
        else if (factor >= 3) factor += 2
        else factor = 3
    }
}

fun isPrime(n: Int) : Boolean {
    if (n < 2) return false
    if (n % 2 == 0) return n == 2
    if (n % 3 == 0) return n == 3
    var d = 5
    while (d * d <= n) {
        if (n % d == 0) return false
        d += 2
        if (n % d == 0) return false
        d += 4
    }
    return true
}

fun main(args: Array<String>) {
    val numbers = listOf(
        12757923, 12878611, 12878893, 12757923, 15808973, 15780709, 197622519
    )
    val info = numbers.stream()
                      .parallel()
                      .map { primeFactorInfo(it) }
                      .collect(Collectors.toList())
    val maxFactor = info.maxBy { it.second }!!.second
    val results = info.filter { it.second == maxFactor }
    println("The following number(s) have the largest minimal prime factor of $maxFactor:")
    for (result in results) {
        println("  ${result.first} whose prime factors are ${result.third}")
    }
}


hasSmallestFactor[data_List]:=Sort[Transpose[{ParallelTable[FactorInteger[x][[1, 1]], {x, data}],data}]][[1, 2]]


import strformat, strutils, threadpool

const Numbers = [576460752303423487,
                 576460752303423487,
                 576460752303423487,
                 112272537195293,
                 115284584522153,
                 115280098190773,
                 115797840077099,
                 112582718962171,
                 299866111963290359]

proc lowestFactor(n: int64): int64 =
  if n mod 2 == 0: return 2
  if n mod 3 == 0: return 3
  var p = 5
  var delta = 2
  while p * p < n:
    if n mod p == 0: return p
    inc p, delta
    delta = 6 - delta
  result = n

proc factors(n, lowest: int64): seq[int64] =
  var n = n
  var lowest = lowest
  while true:
    result.add lowest
    n = n div lowest
    if n == 1: break
    lowest = lowestFactor(n)

# Launch a thread for each number to process.
var responses: array[Numbers.len, FlowVar[int64]]
for i, n in Numbers:
  responses[i] = spawn lowestFactor(n)

# Read the results and find the largest minimum prime factor.
var maxMinfact = 0i64
var maxIdx: int
for i in 0..responses.high:
  let minfact = ^responses[i]   # Blocking read.
  echo &"For n = {Numbers[i]}, the lowest factor is {minfact}."
  if minfact > maxMinfact:
    maxMinfact = minfact
    maxIdx = i
let result = Numbers[maxIdx]

echo ""
echo "The first number with the largest minimum prime factor is: ", result
echo "Its factors are: ", result.factors(maxMinfact).join(", ")


import: parallel

: largeMinFactor  dup mapParallel(#factors) zip maxFor(#[ second first ]) ;


/* Concurrency in ooRexx. Example of early reply */
object1 = .example~new
object2 = .example~new
say object1~primes(1,11111111111,11111111114)
say object2~primes(2,11111111111,11111111114)
say "Main ended at" time()
exit
::class example
::method primes
use arg which,bot,top
reply "Start primes"which':' time()
Select
  When which=1 Then Call pd1 bot top
  When which=2 Then Call pd2 bot top
  End


'CONFIGURATION
'=============

% max     8192  'Maximum amount of Prime Numbers (must be 2^n) (excluding 1 and 2)
% cores   4     'CPU cores available (limited to 4 here)
% share   2048  'Amount of numbers allocated to each core

'SETUP
'=====

'SOURCE DATA BUFFERS

sys primes[max]
sys numbers[max]

'RESULT BUFFER

double pp[max] 'main thread

'MULTITHREADING AND TIMING API
'=============================

extern lib "kernel32.dll"
'
void   QueryPerformanceCounter(quad*c)
void   QueryPerformanceFrequency(quad*freq)
sys    CreateThread (sys lpThreadAttributes, dwStackSize, lpStartAddress, lpParameter, dwCreationFlags, *lpThreadId)
dword  WaitForMultipleObjects(sys nCount,*lpHandles, bWaitAll, dwMilliseconds)
bool   CloseHandle(sys hObject)
void   Sleep(sys dwMilliSeconds)
'
quad freq,t1,t2
QueryPerformanceFrequency freq

'MACROS AND FUNCTIONS
'====================

macro FindPrimes(p)
'==================
finit
sys n=1
sys c,k
do
  n+=2
  if c>=max then exit do
  '
  'IS IT DIVISIBLE BE ANY PREVIOUS PRIME
  '
  for k=1 to c
     if frac(n/p[k])=0 then exit for
  next
  '
  if k>c then
    c++
    p[c]=n 'STORE PRIME
  end if
end do
end macro

macro ProcessNumbers(p,bb)
'=========================
finit
sys i,b,e
b=bb*share
e=b+share
sys v,w
for i=b+1 to e
  v=numbers(i)
  for j=max to 1 step -1
    w=primes(j)
    if w<v then
      if frac(v/w)=0 then
        p(i)=primes(j)    'store highest factor
        exit for          'process next number
      end if
    end if
  next
next
end macro

'THREAD FUNCTIONS

function threadA(sys v) as sys
ProcessNumbers(pp,v)
end function

function threadB(sys v) as sys
ProcessNumbers(pp,v)
end function

function threadC(sys v) as sys
ProcessNumbers(pp,v)
end function

end extern

function mainThread(sys b)
'===========================
ProcessNumbers(pp,b)
end function

'SOURCE DATA GENERATION

sys seed = 0x12345678

function Rnd() as sys
'====================
'
mov eax,seed
rol eax,7
imul eax,eax,13
mov seed,eax
return eax
end function

function GenerateNumbers()
'=========================
sys i,v,mask
mask=max * 8 -1 'as bit mask
for i=1 to max
  v=rnd()
  v and=mask
  numbers(i)=v
next
end function

FindPrimes(primes)

GenerateNumbers()

% threads Cores-1

% INFINITE 0xFFFFFFFF  'Infinite timeout

sys Funs[threads]={@threadA,@threadB,@threadC} '3 additional threads
sys  hThread[threads], id[threads], i
'
'START TIMER
'
QueryPerformanceCounter   t1
'
for i=1 to threads
  hThread(i) =  CreateThread 0,0,funs(i),i,0,id(i)
next

MainThread(0) 'process numbers in main thread (bottom share)

if threads>0 then
  WaitForMultipleObjects Threads, hThread, 1, INFINITE
end if

for i=1 to Threads
  CloseHandle hThread(i)
next

'CAPTURE NUMBER WITH HIGHEST PRIME FACTOR

sys n,f
for i=1 to max
  if pp(i)>f then f=pp(i) : n=i
next

'STOP TIMER

QueryPerformanceCounter t2

print str((t2-t1)/freq,3) " secs    " numbers(n) "    " f 'number with highest prime factor


--
-- demo\rosetta\ParallelCalculations.exw
-- =====================================
--
--  Proof that more threads can make things faster...
--
without js -- (threads)
include mpfr.e
sequence res
constant res_cs = init_cs()         -- critical section

procedure athread()
    mpz z = mpz_init()
    while true do
        integer found = 0
        enter_cs(res_cs)
        for i=1 to length(res) do
            if integer(res[i])
            and res[i]>0 then
                found = i
                res[i] = 0
                exit
            end if
        end for
        leave_cs(res_cs)
        if not found then exit end if
        mpz_ui_pow_ui(z,2,found)
        mpz_add_ui(z,z,1)
        object r = mpz_prime_factors(z, 1_000_000)
        enter_cs(res_cs)
        res[found] = r
        r = 0
        leave_cs(res_cs)
    end while
    exit_thread(0)
end procedure

for nthreads=1 to 5 do
    progress("testing %d threads...",{nthreads})
    atom t0 = time()
    res = tagset(100)
    sequence threads = {}
    for i=1 to nthreads do
        threads = append(threads,create_thread(routine_id("athread"),{}))
    end for
    wait_thread(threads)
    integer k = largest(res,true)
    string e = elapsed(time()-t0)
    printf(1,"largest is 2^%d+1 with smallest factor of %d (%d threads, %s)\n",
             {k,res[k][1][1],nthreads,e})
end for
delete_cs(res_cs)


threaded_decomp(Number,ID):-
	thread_create(
		      (prime_decomp(Number,Y),
		       thread_exit((Number,Y)))
		     ,ID,[]).

threaded_decomp_list(List,Erg):-
	maplist(threaded_decomp,List,IDs),
	maplist(thread_join,IDs,Results),
	maplist(pack_exit_out,Results,Smallest_Factors_List),
	largest_min_factor(Smallest_Factors_List,Erg).

pack_exit_out(exited(X),X).
%Note that here some error handling should happen.

largest_min_factor([(N,Facs)|A],(N2,Fs2)):-
	min_list(Facs,MF),
	largest_min_factor(A,(N,MF,Facs),(N2,_,Fs2)).

largest_min_factor([],Acc,Acc).
largest_min_factor([(N1,Facs1)|Rest],(N2,MF2,Facs2),Goal):-
	min_list(Facs1, MF1),
	(MF1 > MF2->
	largest_min_factor(Rest,(N1,MF1,Facs1),Goal);
	largest_min_factor(Rest,(N2,MF2,Facs2),Goal)).

format_it(List):-
	threaded_decomp_list(List,(Number,Factors)),
	format('Number with largest minimal Factor is ~w\nFactors are ~w\n',
	       [Number,Factors]).


Structure IO_block
  ThreadID.i
  StartSeamaphore.i
  Value.q
  MinimumFactor.i
  List Factors.i()
EndStructure
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Declare Factorize(*IO.IO_block)
Declare main()
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Main()
End
;\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Procedure Main()
  Protected AvailableCpu, MainSemaphore
  Protected i, j, qData.q, Title$, Message$
  NewList T.IO_block()
  ;
  AvailableCpu = Val(GetEnvironmentVariable("NUMBER_OF_PROCESSORS"))
  If AvailableCpu<1: AvailableCpu=1: EndIf
  MainSemaphore = CreateSemaphore(AvailableCpu)
  ;
  Restore Start_of_data
  For i=1 To (?end_of_data-?Start_of_data) / SizeOf(Quad)
    ; Start all threads at ones, they will then be let to
    ; self-oganize according to the availiable Cores.
    AddElement(T())
    Read.q  qData
    T()\Value = qData
    T()\StartSeamaphore = MainSemaphore
    T()\ThreadID = CreateThread(@Factorize(), @T())
  Next
  ;
  ForEach T()
    ; Wait for all threads to complete their work and
    ; find the smallest factor from eact task.
    WaitThread(T()\ThreadID)
  Next
  ;
  i = OffsetOf(IO_block\MinimumFactor)
  SortStructuredList(T(), #PB_Sort_Integer, i, #PB_Sort_Descending)
  FirstElement(T())
  Title$="Info"
  Message$="Number "+Str(T()\Value)+" has largest minimal factor:"+#CRLF$
  ForEach T()\Factors()
    Message$ + Str(T()\Factors())+" "
  Next
  MessageRequester(Title$, Message$)
EndProcedure

ProcedureDLL Factorize(*IO.IO_block) ; Fill list Factors() with the factor parts of Number
  ;Based on http://rosettacode.org/wiki/Prime_decomposition#PureBasic
  With *IO
    Protected Value.q=\Value
    WaitSemaphore(\StartSeamaphore)
    Protected I = 3
    ClearList(\Factors())
    While Value % 2 = 0
      AddElement(\Factors())
      \Factors() = 2
      Value / 2
    Wend
    Protected Max = Value
    While I <= Max And Value > 1
      While Value % I = 0
        AddElement(\Factors())
        \Factors() = I
        Value / I
      Wend
      I + 2
    Wend
    SortList(\Factors(), #PB_Sort_Ascending)
    FirstElement(\Factors())
    \MinimumFactor=\Factors()
    SignalSemaphore(\StartSeamaphore)
  EndWith ;*IO
EndProcedure

DataSection
  Start_of_data: ; Same numbers as Ada
  Data.q  12757923, 12878611, 12757923, 15808973, 15780709, 197622519
  end_of_data:
EndDataSection


from concurrent import futures
from math import floor, sqrt

NUMBERS = [
    112272537195293,
    112582718962171,
    112272537095293,
    115280098190773,
    115797840077099,
    1099726829285419]
# NUMBERS = [33, 44, 55, 275]

def lowest_factor(n, _start=3):
    if n % 2 == 0:
        return 2
    search_max = int(floor(sqrt(n))) + 1
    for i in range(_start, search_max, 2):
        if n % i == 0:
            return i
    return n

def prime_factors(n, lowest):
    pf = []
    while n > 1:
        pf.append(lowest)
        n //= lowest
        lowest = lowest_factor(n, max(lowest, 3))
    return pf

def prime_factors_of_number_with_lowest_prime_factor(NUMBERS):
    with futures.ProcessPoolExecutor() as executor:
        low_factor, number = max( (l, f) for l, f in zip(executor.map(lowest_factor, NUMBERS), NUMBERS) )
        all_factors = prime_factors(number, low_factor)
        return number, all_factors

def main():
    print('For these numbers:')
    print('\n  '.join(str(p) for p in NUMBERS))
    number, all_factors = prime_factors_of_number_with_lowest_prime_factor(NUMBERS)
    print('    The one with the largest minimum prime factor is {}:'.format(number))
    print('      All its prime factors in order are: {}'.format(all_factors))

if __name__ == '__main__':
    main()


#lang racket
(require math)
(provide main)

(define (smallest-factor n)
  (list (first (first (factorize n))) n))

(define numbers
  '(112272537195293 112582718962171 112272537095293
    115280098190773 115797840077099 1099726829285419))

(define (main)
  ; create as many instances of Racket as
  ; there are numbers:
  (define ps
    (for/list ([_ numbers])
      (place ch
             (place-channel-put
              ch
              (smallest-factor
               (place-channel-get ch))))))
  ; send the numbers to the instances:
  (map place-channel-put ps numbers)
  ; get the results and find the maximum:
  (argmax first (map place-channel-get ps)))


//! This solution uses [rayon](https://github.com/rayon-rs/rayon), a data-parallelism library.
//! Since Rust guarantees that a program has no data races, adding parallelism to a sequential
//! computation is as easy as importing the rayon traits and calling the `par_iter()` method.

extern crate rayon;

extern crate prime_decomposition;

use rayon::prelude::*;

/// Returns the largest minimal factor of the numbers in a slice
pub fn largest_min_factor(numbers: &[usize]) -> usize {
    numbers
        .par_iter()
        .map(|n| {
            // `factor` returns a sorted vector, so we just take the first element.
            prime_decomposition::factor(*n)[0]
        })
        .max()
        .unwrap()
}

fn main() {
    let numbers = &[
        1_122_725, 1_125_827, 1_122_725, 1_152_800, 1_157_978, 1_099_726,
    ];
    let max = largest_min_factor(numbers);
    println!("The largest minimal factor is {}", max);
}


import <Utilities/Conversion.sl>;
import <Utilities/Math.sl>;
import <Utilities/Sequence.sl>;

main(args(2)) :=
	let
		inputs := stringToInt(args);
		factored := primeFactorization(inputs);
		minFactors := vectorMin(factored);

		indexOfMax := firstIndexOf(minFactors, vectorMax(minFactors));
	in
		"Number " ++ intToString(inputs[indexOfMax]) ++ " has largest minimal factor:\n"  ++ delimit(intToString(factored[indexOfMax]), ' ');


structure TTd  =  Thread.Thread ;
structure TTm  =  Thread.Mutex  ;

val threadedBigPrime =  fn input:IntInf.int list  =>

let

(* --------------------- code from prime decomposition page  ------------------- *)
  val factor = fn n :IntInf.int  =>
   let
     val unfactored  = fn (u,_,_)   => u; val factors = fn (_,f,_) => f; val try  = fn (_,_,i)   => i; fun getresult t = unfactored t::(factors t);
     fun until done change x = if done x  then getresult x else until done change (change x);       (* iteration *)
     fun lastprime t = unfactored t  <  (try t)*(try t)
     fun trymore t   = if unfactored t mod (try t) = 0  then (unfactored t div (try t) , try t::(factors t) , try t) else (unfactored t, factors t , try t + 1)
   in  until lastprime trymore (n,[],2)  end;
(* --------------------- end of code from prime decomposition page  ------------ *)

 val mx   =  TTm.mutex () ;
 val results :  IntInf.int list list ref  =  ref [  ] ;
 val tasks   :  IntInf.int list list ref  =  ref [  ] ;

 val divideup =  fn cores => fn inp : IntInf.int list =>
  let
   val np = (List.length inp) div cores + (cores +1) div cores                          (* assume length > cores to reduce code *)
   val rec divd = fn ([], outp)    =>  ([],outp )
                      | (inp,outp) =>  divd ( List.drop (inp,np) , (List.take (inp,np))::outp )  handle Subscript => ([],inp :: outp)
  in
    #2 ( divd (inp, [ ] ))
  end;

 val doTask =  fn () =>
  let
    val mytask :  IntInf.int list ref     = ref [];
    val myres  : IntInf.int list list ref = ref [];
  in
   (   TTm.lock mx ; mytask :=  hd ( !tasks ) ;  tasks:= tl (!tasks)   ; TTm.unlock mx ;
       myres  :=  List.map  factor ( !mytask ) ;
       TTm.lock mx ; results :=  !myres @ ( !results )   ; TTm.unlock mx ;
       TTd.exit ()
   )
 end;

 val cores     =  TTd.numProcessors ();
 val tmp       =  tasks :=  divideup cores input ;
 val processes =  List.tabulate ( cores , fn i => TTd.fork (doTask , []) ) ;
 val maxim     =  ( while ( List.exists TTd.isActive processes ) do (Posix.Process.sleep (Time.fromReal 1.0 ));
                    List.foldr IntInf.max  1 ( List.map (fn i => List.last i ) (!results) ) )                   (* maximal lowest prime *)

in

   List.filter (fn lst => List.last lst = maxim ) (!results)

end ;


import BigInt
import Foundation

extension BinaryInteger {
  @inlinable
  public func primeDecomposition() -> [Self] {
    guard self > 1 else { return [] }

    func step(_ x: Self) -> Self {
      return 1 + (x << 2) - ((x >> 1) << 1)
    }

    let maxQ = Self(Double(self).squareRoot())
    var d: Self = 1
    var q: Self = self & 1 == 0 ? 2 : 3

    while q <= maxQ && self % q != 0 {
      q = step(d)
      d += 1
    }

    return q <= maxQ ? [q] + (self / q).primeDecomposition() : [self]
  }
}

let numbers = [
  112272537195293,
  112582718962171,
  112272537095293,
  115280098190773,
  115797840077099,
  1099726829285419,
  1275792312878611,
  BigInt("64921987050997300559")
]

func findLargestMinFactor<T: BinaryInteger>(for nums: [T], then: @escaping ((n: T, factors: [T])) -> ()) {
  let waiter = DispatchSemaphore(value: 0)
  let lock = DispatchSemaphore(value: 1)
  var factors = [(n: T, factors: [T])]()

  DispatchQueue.concurrentPerform(iterations: nums.count) {i in
    let n = nums[i]

    print("Factoring \(n)")

    let nFacs = n.primeDecomposition().sorted()

    print("Factored \(n)")

    lock.wait()
    factors.append((n, nFacs))

    if factors.count == nums.count {
      waiter.signal()
    }

    lock.signal()
  }

  waiter.wait()

  then(factors.sorted(by: { $0.factors.first! > $1.factors.first! }).first!)
}

findLargestMinFactor(for: numbers) {res in
  let (n, factors) = res

  print("Number with largest min prime factor: \(n); factors: \(factors)")

  exit(0)
}

dispatchMain()


package require Tcl 8.6
package require Thread

# Pooled computation engine; runs event loop internally
namespace eval pooled {
    variable poolSize 3; # Needs to be tuned to system size

    proc computation {computationDefinition entryPoint values} {
	variable result
	variable poolSize
	# Add communication shim
	append computationDefinition [subst -nocommands {
	    proc poolcompute {value target} {
		set outcome [$entryPoint \$value]
		set msg [list set ::pooled::result(\$value) \$outcome]
		thread::send -async \$target \$msg
	    }
	}]

	# Set up the pool
	set pool [tpool::create -initcmd $computationDefinition \
		      -maxworkers $poolSize]

	# Prepare to receive results
	unset -nocomplain result
	array set result {}

	# Dispatch the computations
	foreach value $values {
	    tpool::post $pool [list poolcompute $value [thread::id]]
	}

	# Wait for results
	while {[array size result] < [llength $values]} {vwait pooled::result}

	# Dispose of the pool
	tpool::release $pool

	# Return the results
	return [array get result]
    }
}


/* parallel_calculations.wren */

import "./math" for Int

class C {
    static minPrimeFactor(n)  { Int.primeFactors(n)[0] }

    static allPrimeFactors(n) { Int.primeFactors(n) }
}


fcn factorize(x,y,z,etc){
   xyzs:=vm.arglist;
   fs:=xyzs.apply(factors.strand) // queue up factorizing for x,y,...
       .apply("noop")		  // wait for all threads to finish factoring
       .apply(fcn{ (0).min(vm.arglist) }); // find minimum factor for x,y...
   [0..].zip(fs).filter(fcn([(n,x)],M){ x==M }.fp1((0).max(fs))) // find max of mins
   .apply('wrap([(n,_)]){ xyzs[n] })  // and pluck src from arglist
}


-V ops = ‘-+/*^’

F postfix_to_infix(postfix)
   T Expression
      String op, ex
      prec = 3

      F (String e1, e2 = ‘’, o = ‘’)
         I o == ‘’
            .ex = e1
         E
            .ex = e1‘ ’o‘ ’e2
            .op = o
            .prec = :ops.index(o) I/ 2

      F String()
         R .ex

   [Expression] expr

   L(token) postfix.split(re:‘\s+’)
      V c = token[0]
      V? idx = :ops.find(c)
      I idx != N
         V r = expr.pop()
         V l = expr.pop()
         V opPrec = idx I/ 2

         I l.prec < opPrec | (l.prec == opPrec & c == ‘^’)
            l.ex = ‘(’l.ex‘)’

         I r.prec < opPrec | (r.prec == opPrec & c != ‘^’)
            r.ex = ‘(’r.ex‘)’
         expr.append(Expression(l.ex, r.ex, token))
      E
         expr.append(Expression(token))

      print(token‘ -> ’expr)

   assert(expr.len == 1)
   R expr[0].ex

L(e) [‘3 4 2 * 1 5 - 2 3 ^ ^ / +’,
      ‘1 2 + 3 4 + ^ 5 6 + ^’]
   print(‘Postfix : ’e)
   print(‘Infix : ’postfix_to_infix(e))
   print()


   type Priority is range 1..4;
   type Infix is record
      Precedence : Priority;
      Expression : Unbounded_String;
   end record;
   package Expression_Stack is new Generic_Stack (Infix);
   use Expression_Stack;

   function Convert (RPN : String) return String is
      Arguments : Stack;
      procedure Pop
                (  Operation   : Character;
                   Precedence  : Priority;
                   Association : Priority
                )  is
         Right, Left : Infix;
         Result      : Infix;
      begin
         Pop (Right, Arguments);
         Pop (Left,  Arguments);
         Result.Precedence := Association;
         if Left.Precedence < Precedence then
            Append (Result.Expression, '(');
            Append (Result.Expression, Left.Expression);
            Append (Result.Expression, ')');
         else
            Append (Result.Expression, Left.Expression);
         end if;
         Append (Result.Expression, ' ');
         Append (Result.Expression, Operation);
         Append (Result.Expression, ' ');
         if Right.Precedence < Precedence then
            Append (Result.Expression, '(');
            Append (Result.Expression, Right.Expression);
            Append (Result.Expression, ')');
         else
            Append (Result.Expression, Right.Expression);
         end if;
         Push (Result, Arguments);
      end Pop;
      Pointer : Integer := RPN'First;
   begin
      while Pointer <= RPN'Last loop
         case RPN (Pointer) is
            when ' ' =>
               Pointer := Pointer + 1;
            when '0'..'9' =>
               declare
                  Start : constant Integer := Pointer;
               begin
                  loop
                     Pointer := Pointer + 1;
                     exit when Pointer > RPN'Last
                       or else RPN (Pointer) not in '0'..'9';
                  end loop;
                  Push
                  (  (  4,
                        To_Unbounded_String (RPN (Start..Pointer - 1))
                     ),
                     Arguments
                  );
               end;
            when '+' | '-' =>
               Pop (RPN (Pointer), 1, 1);
               Pointer := Pointer + 1;
            when '*' | '/' =>
               Pop (RPN (Pointer), 2, 2);
               Pointer := Pointer + 1;
            when '^' =>
               Pop (RPN (Pointer), 4, 3);
               Pointer := Pointer + 1;
            when others =>
               raise Constraint_Error with "Syntax";
         end case;
      end loop;
      declare
         Result : Infix;
      begin
         Pop (Result, Arguments);
         return To_String (Result.Expression);
      end;
   end Convert;


# rpn to infix - parses an RPN expression and generates the equivalent        #
#               infix expression                                              #
PROC rpn to infix = ( STRING rpn )STRING:
BEGIN

    # we parse the string backwards using recursive descent                   #
    INT    rpn pos   := UPB rpn;
    BOOL   had error := FALSE;

    # mode to hold nodes of the parse tree                                    #
    MODE NODE = STRUCT( INT op
                      , UNION( REF NODE, STRING ) left
                      , REF NODE right
                      );

    REF NODE nil node = NIL;

    # op codes                                                                #
    INT error            = 1;
    INT factor           = 2;
    INT add              = 3;
    INT sub              = 4;
    INT mul              = 5;
    INT div              = 6;
    INT pwr              = 7;

    []STRING op name     = ( "error", "factor", "+", "-", "*", "/", "^" );
    []BOOL   right associative
                         = ( FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE );
    []INT    priority    = ( 1, 1, 2, 2, 3, 3, 4 );

    # returns TRUE  if we have reached the end of the rpn string,             #
    #         FALSE otherwise                                                 #
    PROC at end = BOOL: rpn pos < LWB rpn;

    # positions to the previous character, if there is one                    #
    PROC next = VOID: rpn pos -:= 1;

    # skip spaces in the rpn string                                           #
    PROC skip spaces = VOID:
        WHILE have( " " )
        DO
            next
        OD # skip spaces # ;

    # returns TRUE  if the rpn character at rpn pos is c,                     #
    #         FALSE if the character is not c or there is no character        #
    #               at rpn pos                                                #
    PROC have = ( CHAR c )BOOL:
        IF at end
        THEN
            # no character at rpn pos #
            FALSE
        ELSE
            # have a character - check it is the required one #
            rpn[ rpn pos ] = c
        FI # have # ;

    # gets an operand from the rpn string                                     #
    # an operand is either a number or a sub-expression                       #
    PROC get operand = ( STRING rpn, STRING operand name )REF NODE:
    BEGIN

        # handle the operator or operand, if there is one                     #

        skip spaces;

        print( ( ( "parsing "
                 + operand name
                 + " from: "
                 + IF at end THEN "" ELSE rpn[ LWB rpn : rpn pos ] FI
                 )
               , newline
               )
             );

        REF NODE result :=
            IF   at end
            THEN
                # no operand #
                had error       := TRUE;
                HEAP NODE       := ( error, "!! Missing operand !!", NIL )
            ELIF have( "+" )
            THEN
                # addition #
                next;
                HEAP NODE right := get operand( rpn, "+ right operand" );
                HEAP NODE left  := get operand( rpn, "+ left operand"  );
                HEAP NODE       := ( add, left, right )
            ELIF have( "-" )
            THEN
                # subtraction #
                next;
                HEAP NODE right := get operand( rpn, "- right operand" );
                HEAP NODE left  := get operand( rpn, "- left operand"  );
                HEAP NODE       := ( sub, left, right )
            ELIF have( "*" )
            THEN
                # multiplication #
                next;
                HEAP NODE right := get operand( rpn, "* right operand" );
                HEAP NODE left  := get operand( rpn, "* left operand"  );
                HEAP NODE       := ( mul, left, right )
            ELIF have( "/" )
            THEN
                # division #
                next;
                HEAP NODE right := get operand( rpn, "/ right operand" );
                HEAP NODE left  := get operand( rpn, "/ left operand"  );
                HEAP NODE       := ( div, left, right )
            ELIF have( "^" )
            THEN
                # exponentiation #
                next;
                HEAP NODE right := get operand( rpn, "^ right operand" );
                HEAP NODE left  := get operand( rpn, "^ left operand"  );
                HEAP NODE       := ( pwr, left, right )
            ELSE
                # must be an operand #
                STRING value := "";

                WHILE NOT at end
                  AND NOT have( " " )
                DO
                    rpn[ rpn pos ] +=: value;
                    next
                OD;

                HEAP NODE := ( factor, value, NIL )
            FI;

        print( ( operand name + ": " + TOSTRING result, newline ) );

        result
    END # get operand # ;

    # converts the parse tree to a string with apppropriate parenthesis       #
    OP TOSTRING = ( REF NODE operand )STRING:
    BEGIN

        # converts a node of the parse tree to a string, inserting            #
        # parenthesis if necessary                                            #
        PROC possible parenthesis = ( INT op, REF NODE expr )STRING:
            IF op OF expr = error
            OR op OF expr = factor
            THEN
                # operand is an error/factor - parenthisis not needed #
                TOSTRING expr
            ELIF priority( op OF expr ) < priority( op )
            THEN
                # the expression is a higher precedence operator than the     #
                # one we are building the expression for - need parenthesis   #
                ( "( " + TOSTRING expr + " )" )
            ELIF right associative[ op OF operand ]
             AND op OF left( operand ) = op OF operand
            THEN
                # right associative operator                                  #
                ( "( " + TOSTRING expr + " )" )
            ELSE
                # lower precedence expression - parenthesis not needed        #
                TOSTRING expr
            FI # possible parenthesis # ;

        # gets the left branch of a node, which must be a node                #
        PROC left  = ( REF NODE operand )REF NODE:
            CASE left OF operand
            IN ( REF NODE o ): o
            ,  ( STRING   s ): HEAP NODE := ( error, s, NIL )
            ESAC # left # ;

        IF   had error
        THEN
            # an error occured parsing the expression #
            "Invalid expression"
        ELIF operand IS nil node
        THEN
           # no operand? #
            "<empty>"
        ELIF op OF operand = error
          OR op OF operand = factor
        THEN
            # error parsing the expression #
            # or a factor #
            CASE left OF operand
            IN ( REF NODE o ): "Error: String expected: (" + TOSTRING o + ")"
            ,  ( STRING   s ): s
            ESAC
        ELSE
            # general operand #
            ( possible parenthesis( op OF operand, left(    operand ) )
            + " " + op name[ op OF operand ] + " "
            + possible parenthesis( op OF operand, right OF operand   )
            )
        FI
    END # TOSTRING # ;

    STRING result = TOSTRING get operand( rpn, "expression" );

    # ensure there are no more tokens in the string #
    skip spaces;
    IF at end
    THEN
        # OK - there was only one expression #
        result
    ELSE
        # extraneous tokens #
        ( "Error - unexpected text before expression: ("
        + rpn[ LWB rpn : rpn pos ]
        + ")"
        )
    FI
END # rpn to infix # ;

main: (

    # test the RPN to Infix comnverter                                        #
    STRING rpn;

    rpn := "3 4 2 * 1 5 - 2 3 ^ ^ / +";
    print( ( rpn, ":  ", rpn to infix( rpn ), newline, newline ) );

    rpn := "1 2 + 3 4 + ^ 5 6 + ^";
    print( ( rpn, ":  ", rpn to infix( rpn ), newline ) )

)


expr := "3 4 2 * 1 5 - 2 3 ^ ^ / +"

stack := {push: func("ObjInsert"), pop: func("ObjRemove")}
out := "TOKEN`tACTION                  STACK (comma separated)`r`n"
Loop Parse, expr, %A_Space%
{
	token := A_LoopField
	if token is number
		stack.push([0, token])
	if isOp(token)
	{
		b := stack.pop(), a := stack.pop(), p := b.1 > a.1 ? b.1 : a.1
		p := Precedence(token) > p ? precedence(token) : p
		if (a.1 < b.1) and isRight(token)
			stack.push([p, "( " . a.2 " ) " token " " b.2])
		else if (a.1 > b.1) and isLeft(token)
			stack.push([p, a.2 token " ( " b.2 " ) "])
		else
			stack.push([p, a.2 . " " . token . " " . b.2])
	}
	out .= token "`t" (isOp(token) ? "Push Partial expression "
			   : "Push num" space(16)) disp(stack) "`r`n"
}
out .= "`r`n The final output infix expression is: '" disp(stack) "'"
clipboard := out
isOp(t){
       return (!!InStr("+-*/^", t) && t)
}
IsLeft(o){
       return !!InStr("*/+-", o)
}
IsRight(o){
       return o = "^"
}
Precedence(o){
       return (InStr("+-/*^", o)+3)//2
}
Disp(obj){
       for each, val in obj
		if val[2]
			o .= ", " val[2]
       return  SubStr(o,3)
}
Space(n){
       return n>0 ? A_Space Space(n-1) : ""
}


#!/usr/bin/awk -f

BEGIN {
    initStack()
    initOpers()
    print "Infix: " toInfix("3 4 2 * 1 5 - 2 3 ^ ^ / +")
    print ""
    print "Infix: " toInfix("1 2 + 3 4 + ^ 5 6 + ^")
    print ""
    print "Infix: " toInfix("moon stars mud + * fire soup * ^")
    exit
}

function initStack() {
    delete stack
    stackPtr = 0
}

function initOpers() {
    VALPREC = "9"
    LEFT = "l"
    RIGHT = "r"
    operToks  = "+"  "-"  "/"  "*"  "^"
    operPrec  = "2"  "2"  "3"  "3"  "4"
    operAssoc = LEFT LEFT LEFT LEFT RIGHT
}

function toInfix(rpn,      t, toks, tok, a, ap, b, bp, tp, ta) {
    print "Postfix: " rpn
    split(rpn, toks, / +/)
    for (t = 1; t <= length(toks); t++) {
        tok = toks[t]
        if (!isOper(tok)) {
            push(VALPREC tok)
        }
         else {
            b = pop()
            bp = prec(b)
            b = tail(b)
            a = pop()
            ap = prec(a)
            a = tail(a)
            tp = tokPrec(tok)
            ta = tokAssoc(tok)
            if (ap < tp || (ap == tp && ta == RIGHT)) {
                a = "(" a ")"
            }
            if (bp < tp || (bp == tp && ta == LEFT)) {
                b = "(" b ")"
            }
            push(tp a " "  tok " " b)
        }
        print "    " tok " -> " stackToStr()
    }
    return tail(pop())
}

function push(expr) {
    stack[stackPtr] = expr
    stackPtr++
}

function pop() {
    stackPtr--
    return stack[stackPtr]
}

function isOper(tok) {
    return index(operToks, tok) != 0
}

function prec(expr) {
    return substr(expr, 1, 1)
}

function tokPrec(tok) {
    return substr(operPrec, operIdx(tok), 1)
}

function tokAssoc(tok) {
    return substr(operAssoc, operIdx(tok), 1)
}

function operIdx(tok) {
    return index(operToks, tok)
}

function tail(s) {
    return substr(s, 2)
}

function stackToStr(    s, i, t, p) {
    s = ""
    for (i = 0; i < stackPtr; i++) {
        t = stack[i]
        p = prec(t)
        if (index(t, " ")) t = "{" tail(t) "}"
        else t = tail(t)
        s = s "{" p " " t "} "
    }
    return s
}


#include<stdlib.h>
#include<string.h>
#include<stdio.h>

char** components;
int counter = 0;

typedef struct elem{
	char data[10];
	struct elem* left;
	struct elem* right;
}node;

typedef node* tree;

int precedenceCheck(char oper1,char oper2){
	return (oper1==oper2)? 0:(oper1=='^')? 1:(oper2=='^')? 2:(oper1=='/')? 1:(oper2=='/')? 2:(oper1=='*')? 1:(oper2=='*')? 2:(oper1=='+')? 1:(oper2=='+')? 2:(oper1=='-')? 1:2;
}

int isOperator(char c){
	return (c=='+'||c=='-'||c=='*'||c=='/'||c=='^');
}

void inorder(tree t){
	if(t!=NULL){
		if(t->left!=NULL && isOperator(t->left->data[0])==1 && (precedenceCheck(t->data[0],t->left->data[0])==1 || (precedenceCheck(t->data[0],t->left->data[0])==0 && t->data[0]=='^'))){
			printf("(");
			inorder(t->left);
			printf(")");
		}
		else
			inorder(t->left);

		printf(" %s ",t->data);

		if(t->right!=NULL && isOperator(t->right->data[0])==1 && (precedenceCheck(t->data[0],t->right->data[0])==1 || (precedenceCheck(t->data[0],t->right->data[0])==0 && t->data[0]!='^'))){
			printf("(");
			inorder(t->right);
			printf(")");
		}
		else
			inorder(t->right);
	}
}

char* getNextString(){
	if(counter<0){
		printf("\nInvalid RPN !");
		exit(0);
	}
	return components[counter--];
}

tree buildTree(char* obj,char* trace){
	tree t = (tree)malloc(sizeof(node));

	strcpy(t->data,obj);

	t->right = (isOperator(obj[0])==1)?buildTree(getNextString(),trace):NULL;
	t->left = (isOperator(obj[0])==1)?buildTree(getNextString(),trace):NULL;

	if(trace!=NULL){
			printf("\n");
			inorder(t);
	}

	return t;
}

int checkRPN(){
	int i, operSum = 0, numberSum = 0;

	if(isOperator(components[counter][0])==0)
		return 0;

	for(i=0;i<=counter;i++)
		(isOperator(components[i][0])==1)?operSum++:numberSum++;

	return (numberSum - operSum == 1);
}

void buildStack(char* str){
	int i;
	char* token;

	for(i=0;str[i]!=00;i++)
		if(str[i]==' ')
			counter++;

	components = (char**)malloc((counter + 1)*sizeof(char*));

	token = strtok(str," ");

	i = 0;

	while(token!=NULL){
		components[i] = (char*)malloc(strlen(token)*sizeof(char));
		strcpy(components[i],token);
		token = strtok(NULL," ");
		i++;
	}
}

int main(int argC,char* argV[]){
	int i;
	tree t;

	if(argC==1)
		printf("Usage : %s <RPN expression enclosed by quotes> <optional parameter to trace the build process>",argV[0]);
	else{
		buildStack(argV[1]);

		if(checkRPN()==0){
			printf("\nInvalid RPN !");
			return 0;
		}

		t = buildTree(getNextString(),argV[2]);

		printf("\nFinal infix expression : ");
		inorder(t);
	}

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text.RegularExpressions;

namespace PostfixToInfix
{
    class Program
    {
        class Operator
        {
            public Operator(char t, int p, bool i = false)
            {
                Token = t;
                Precedence = p;
                IsRightAssociative = i;
            }

            public char Token { get; private set; }
            public int Precedence { get; private set; }
            public bool IsRightAssociative { get; private set; }
        }

        static IReadOnlyDictionary<char, Operator> operators = new Dictionary<char, Operator>
        {
            { '+', new Operator('+', 2) },
            { '-', new Operator('-', 2) },
            { '/', new Operator('/', 3) },
            { '*', new Operator('*', 3) },
            { '^', new Operator('^', 4, true) }
        };

        class Expression
        {
            public String ex;
            public Operator op;

            public Expression(String e)
            {
                ex = e;
            }

            public Expression(String e1, String e2, Operator o)
            {
                ex = String.Format("{0} {1} {2}", e1, o.Token, e2);
                op = o;
            }
        }

        static String PostfixToInfix(String postfix)
        {
            var stack = new Stack<Expression>();

            foreach (var token in Regex.Split(postfix, @"\s+"))
            {
                char c = token[0];

                var op = operators.FirstOrDefault(kv => kv.Key == c).Value;
                if (op != null && token.Length == 1)
                {
                    Expression rhs = stack.Pop();
                    Expression lhs = stack.Pop();

                    int opPrec = op.Precedence;

                    int lhsPrec = lhs.op != null ? lhs.op.Precedence : int.MaxValue;
                    int rhsPrec = rhs.op != null ? rhs.op.Precedence : int.MaxValue;

                    if ((lhsPrec < opPrec || (lhsPrec == opPrec && c == '^')))
                        lhs.ex = '(' + lhs.ex + ')';

                    if ((rhsPrec < opPrec || (rhsPrec == opPrec && c != '^')))
                        rhs.ex = '(' + rhs.ex + ')';

                    stack.Push(new Expression(lhs.ex, rhs.ex, op));
                }
                else
                {
                    stack.Push(new Expression(token));
                }

                // print intermediate result
                Console.WriteLine("{0} -> [{1}]", token,
                    string.Join(", ", stack.Reverse().Select(e => e.ex)));
            }
            return stack.Peek().ex;
        }

        static void Main(string[] args)
        {
            string[] inputs = { "3 4 2 * 1 5 - 2 3 ^ ^ / +", "1 2 + 3 4 + ^ 5 6 + ^" };
            foreach (var e in inputs)
            {
                Console.WriteLine("Postfix : {0}", e);
                Console.WriteLine("Infix : {0}", PostfixToInfix(e));
                Console.WriteLine(); ;
            }
            Console.ReadLine();
        }
    }
}


#include <iostream>
#include <stack>
#include <string>
#include <map>
#include <set>

using namespace std;

struct Entry_
{
	string expr_;
	string op_;
};

bool PrecedenceLess(const string& lhs, const string& rhs, bool assoc)
{
	static const map<string, int> KNOWN({ { "+", 1 }, { "-", 1 }, { "*", 2 }, { "/", 2 }, { "^", 3 } });
	static const set<string> ASSOCIATIVE({ "+", "*" });
	return (KNOWN.count(lhs) ? KNOWN.find(lhs)->second : 0) < (KNOWN.count(rhs) ? KNOWN.find(rhs)->second : 0) + (assoc && !ASSOCIATIVE.count(rhs) ? 1 : 0);
}
void Parenthesize(Entry_* old, const string& token, bool assoc)
{
	if (!old->op_.empty() && PrecedenceLess(old->op_, token, assoc))
		old->expr_ = '(' + old->expr_ + ')';
}

void AddToken(stack<Entry_>* stack, const string& token)
{
	if (token.find_first_of("0123456789") != string::npos)
		stack->push(Entry_({ token, string() }));	// it's a number, no operator
	else
	{	// it's an operator
		if (stack->size() < 2)
			cout<<"Stack underflow";
		auto rhs = stack->top();
		Parenthesize(&rhs, token, false);
		stack->pop();
		auto lhs = stack->top();
		Parenthesize(&lhs, token, true);
		stack->top().expr_ = lhs.expr_ + ' ' + token + ' ' + rhs.expr_;
		stack->top().op_ = token;
	}
}

string ToInfix(const string& src)
{
	stack<Entry_> stack;
	for (auto start = src.begin(), p = src.begin(); ; ++p)
	{
		if (p == src.end() || *p == ' ')
		{
			if (p > start)
				AddToken(&stack, string(start, p));
			if (p == src.end())
				break;
			start = p + 1;
		}
	}
	if (stack.size() != 1)
		cout<<"Incomplete expression";
	return stack.top().expr_;
}

int main(void)
{
	try
	{
		cout << ToInfix("3 4 2 * 1 5 - 2 3 ^ ^ / +") << "\n";
		cout << ToInfix("1 2 + 3 4 + ^ 5 6 + ^") << "\n";
		return 0;
	}
	catch (...)
	{
		cout << "Failed\n";
		return -1;
	}
}


;;;; Parsing/RPN to infix conversion
(defstruct (node (:print-function print-node)) opr infix)
(defun print-node (node stream depth)
  (format stream "opr:=~A infix:=\"~A\"" (node-opr node) (node-infix node)))

(defconstant OPERATORS '((#\^ . 4) (#\* . 3) (#\/ . 3) (#\+ . 2) (#\- . 2)))

;;; (char,char[,boolean])->boolean
(defun higher-p (opp opc &optional (left-node-p nil))
  (or (> (cdr (assoc opp OPERATORS)) (cdr (assoc opc OPERATORS)))
      (and left-node-p (char= opp #\^) (char= opc #\^))))

;;; string->list
(defun string-split (expr)
  (let ((p (position #\Space expr)))
    (if (null p) (list expr)
        (append (list (subseq expr 0 p))
                (string-split (subseq expr (1+ p)))))))

;;; string->string
(defun parse (expr)
  (let ((stack '()))
    (format t "TOKEN   STACK~%")
    (dolist (tok (string-split expr))
      (if (assoc (char tok 0) OPERATORS) ; operator?
          (push (make-node :opr (char tok 0) :infix (infix (char tok 0) (pop stack) (pop stack))) stack)
          (push tok stack))

      ;; print stack at each token
      (format t "~3,A" tok)
      (dotimes (i (length stack)) (format t "~8,T[~D] ~A~%" i (nth i stack))))

    ;; print final infix expression
    (if (= (length stack) 1)
        (format nil "~A" (node-infix (first stack)))
        (format nil "syntax error in ~A" expr))))

;;; (char,node,node)->string
(defun infix (operator rightn leftn)

  ;; (char,node[,boolean]->string
  (defun string-node (operator anode &optional (left-node-p nil))
    (if (stringp anode) anode
        (if (higher-p operator (node-opr anode) left-node-p)
            (format nil "( ~A )" (node-infix anode)) (node-infix anode))))

  (concatenate 'string
               (string-node operator leftn t)
               (format nil " ~A " operator)
               (string-node operator rightn)))

;;; nil->[printed infix expressions]
(defun main ()
  (let ((expressions '("3 4 2 * 1 5 - 2 3 ^ ^ / +"
                       "1 2 + 3 4 + ^ 5 6 + ^"
                       "3 4 ^ 2 9 ^ ^ 2 5 ^ ^")))
    (dolist (expr expressions)
      (format t "~%Parsing:\"~A\"~%" expr)
      (format t "RPN:\"~A\" INFIX:\"~A\"~%" expr (parse expr)))))


import std.stdio, std.string, std.array;

void parseRPN(in string e) {
    enum nPrec = 9;
    static struct Info { int prec; bool rAssoc; }
    immutable /*static*/ opa = ["^": Info(4, true),
                                "*": Info(3, false),
                                "/": Info(3, false),
                                "+": Info(2, false),
                                "-": Info(2, false)];

    writeln("\nPostfix input: ", e);
    static struct Sf { int prec; string expr; }
    Sf[] stack;
    foreach (immutable tok; e.split()) {
        writeln("Token: ", tok);
        if (tok in opa) {
            immutable op = opa[tok];
            immutable rhs = stack.back;
            stack.popBack();
            auto lhs = &stack.back;
            if (lhs.prec < op.prec ||
                (lhs.prec == op.prec && op.rAssoc))
                lhs.expr = "(" ~ lhs.expr ~ ")";
            lhs.expr ~= " " ~ tok ~ " ";
            lhs.expr ~= (rhs.prec < op.prec ||
                         (rhs.prec == op.prec && !op.rAssoc)) ?
                        "(" ~ rhs.expr ~ ")" :
                        rhs.expr;
            lhs.prec = op.prec;
        } else
            stack ~= Sf(nPrec, tok);
        foreach (immutable f; stack)
            writefln(`    %d "%s"`, f.prec, f.expr);
    }
    writeln("Infix result: ", stack[0].expr);
}

void main() {
    foreach (immutable test; ["3 4 2 * 1 5 - 2 3 ^ ^ / +",
                              "1 2 + 3 4 + ^ 5 6 + ^"])
        parseRPN(test);
}


(require 'hash)
(string-delimiter "")

(define (^ a b ) (expt a b)) ;; add this not-native function
(define-syntax-rule (r-assoc? op) (= op  "^"))
(define-syntax-rule (l-assoc? op) (not ( = op "^" )))
(define PRECEDENCES (list->hash
	'(("+" . 2) ("-" . 2) ("*" . 3) ("/" . 3) ("//" . 3) ("^" . 4))
	(make-hash)))

;; RPN vector or list -> infix tree  ->  (a op (b op c) d) ..
(define (rpn->infix rpn)
(define S (stack 'S))
	(for ((token rpn))
	(if (procedure? token)
		(let [(op2 (pop S)) (op1 (pop S))]
			(unless (and op1 op2)   (error "cannot translate expression" rpn))
	    	(push S (list op1 token op2))
	    	)
	    (push S token ))
	(writeln 'token (string token) 'stack (stack->list S)))
	(begin0
		(pop S) ;; return (top S)
		(unless (stack-empty? S) (error "ill-formed rpn" rpn)))
	)

;; a node  tree is (left op right) or a  number
(define-syntax-id _.left (first _)) ; mynode.left expands to (first mynode)
(define-syntax-id _.right (third _))
(define-syntax-id _.op  (string (second _ )))
(define-syntax-rule (precedence node) (hash-ref PRECEDENCES (string (second node))))

(define (left-par? node) ; does lhs needs ( lhs ) ?
	(cond
	[(number? node.left) #f]
	[(< (precedence node.left) (precedence node)) #t]
	[(and
		 	(r-assoc? node.op)
		 	(= (precedence node.left) (precedence node))) #t]
	[else #f]))

(define (right-par? node)
	(cond
	[(number? node.right) #f]
	[(< (precedence node.right) (precedence node)) #t]
	[(and
		 	(l-assoc? node.op)
		 	(= (precedence node.right) (precedence node))) #t]
	[else #f]))

;; infix tree -> char string
(define (infix->string node)
	(cond
	[(number? node) (string node)]
	[else (let
		[(lhs (infix->string node.left))
		(rhs (infix->string node.right))]
		(when (left-par? node) (set! lhs (string-append "(" lhs ")")))
		(when (right-par? node) (set! rhs (string-append "(" rhs ")")))
		(string-append lhs " " node.op " " rhs))]))


type ast =
    | Num  of int
    | Add  of ast * ast | Sub  of ast * ast
    | Mul  of ast * ast | Div  of ast * ast
    | Exp  of ast * ast

let (|Int|_|) = System.Int32.TryParse >> function | (true, v) -> Some(v) | (false, _) -> None

let rec parse =
    function
    | [] -> failwith "Not enough tokens"
    | (Int head)::tail -> (Num(head), tail)
    | op::tail ->
        let (left, rest1) = parse tail
        let (right, rest2) = parse rest1
        match op with
        | "+" -> (Add (right, left)), rest2
        | "-" -> (Sub (right, left)), rest2
        | "*" -> (Mul (right, left)), rest2
        | "/" -> (Div (right, left)), rest2
        | "^" -> (Exp (right, left)), rest2
        | _ -> failwith ("unknown op: " + op)

let rec infix p x  =
    let brackets (x : ast) = seq { yield "("; yield! infix 0 x; yield ")" }
    let left op context l r = seq { yield! infix context l; yield op; yield! infix context r }
    let right op context l r = seq { yield! brackets l; yield op; yield! infix context r }
    seq {
        match x with
        | Num (n) -> yield n.ToString()
        | Add (l, r) when p <= 2 -> yield! left "+" 2 l r
        | Sub (l, r) when p <= 2 -> yield! left "-" 2 l r
        | Mul (l, r) when p <= 3 -> yield! left "*" 3 l r
        | Div (l, r) when p <= 3 -> yield! left "/" 3 l r
        | Exp (Exp(ll, lr), r)   -> yield! right "^" 4 (Exp(ll,lr)) r
        | Exp (l, r)             -> yield! left "^" 4 l r
        | _ -> yield! brackets x
    }

[<EntryPoint>]
let main argv =
    let (tree, rest) =
        argv |> Array.rev |> Seq.toList |> parse
    match rest with
    | [] -> printfn "%A" tree
    | _ -> failwith ("not a valid RPN expression (excess tokens): " + System.String.Join(" ", argv))
    Seq.iter (printf " %s") (infix 0 tree); printfn ""
    0


package main

import (
    "fmt"
    "strings"
)

var tests = []string{
    "3 4 2 * 1 5 - 2 3 ^ ^ / +",
    "1 2 + 3 4 + ^ 5 6 + ^",
}

var opa = map[string]struct {
    prec   int
    rAssoc bool
}{
    "^": {4, true},
    "*": {3, false},
    "/": {3, false},
    "+": {2, false},
    "-": {2, false},
}

const nPrec = 9

func main() {
    for _, t := range tests {
        parseRPN(t)
    }
}

func parseRPN(e string) {
    fmt.Println("\npostfix:", e)
    type sf struct {
        prec int
        expr string
    }
    var stack []sf
    for _, tok := range strings.Fields(e) {
        fmt.Println("token:", tok)
        if op, isOp := opa[tok]; isOp {
            rhs := &stack[len(stack)-1]
            stack = stack[:len(stack)-1]
            lhs := &stack[len(stack)-1]
            if lhs.prec < op.prec || (lhs.prec == op.prec && op.rAssoc) {
                lhs.expr = "(" + lhs.expr + ")"
            }
            lhs.expr += " " + tok + " "
            if rhs.prec < op.prec || (rhs.prec == op.prec && !op.rAssoc) {
                lhs.expr += "(" + rhs.expr + ")"
            } else {
                lhs.expr += rhs.expr
            }
            lhs.prec = op.prec
        } else {
            stack = append(stack, sf{nPrec, tok})
        }
        for _, f := range stack {
            fmt.Printf("    %d %q\n", f.prec, f.expr)
        }
    }
    fmt.Println("infix:", stack[0].expr)
}


class PostfixToInfix {
    static class Expression {
        final static String ops = "-+/*^"

        String op, ex
        int precedence = 3

        Expression(String e) {
            ex = e
        }

        Expression(String e1, String e2, String o) {
            ex = String.format "%s %s %s", e1, o, e2
            op = o
            precedence = (ops.indexOf(o) / 2) as int
        }

        @Override
        String toString() {
            return ex
        }
    }

    static String postfixToInfix(final String postfix) {
        Stack<Expression> expr = new Stack<>()

        for (String token in postfix.split("\\s+")) {
            char c = token.charAt(0)
            int idx = Expression.ops.indexOf(c as int)
            if (idx != -1 && token.length() == 1) {

                Expression r = expr.pop()
                Expression l = expr.pop()

                int opPrecedence = (idx / 2) as int

                if (l.precedence < opPrecedence || (l.precedence == opPrecedence && c == '^' as char))
                    l.ex = '(' + l.ex + ')'

                if (r.precedence < opPrecedence || (r.precedence == opPrecedence && c != '^' as char))
                    r.ex = '(' + r.ex + ')'

                expr << new Expression(l.ex, r.ex, token)
            } else {
                expr << new Expression(token)
            }
            printf "%s -> %s%n", token, expr
        }
        expr.peek().ex
    }

    static void main(String[] args) {
        (["3 4 2 * 1 5 - 2 3 ^ ^ / +", "1 2 + 3 4 + ^ 5 6 + ^"]).each { String e ->
            printf "Postfix : %s%n", e
            printf "Infix : %s%n", postfixToInfix(e)
            println()
        }
    }
}


import Debug.Trace

data Expression = Const String | Exp Expression String Expression

------------- INFIX EXPRESSION FROM RPN STRING -----------

infixFromRPN :: String -> Expression
infixFromRPN = head . foldl buildExp [] . words

buildExp :: [Expression] -> String -> [Expression]
buildExp stack x
  | (not . isOp) x =
    let v = Const x : stack
     in trace (show v) v
  | otherwise =
    let v = Exp l x r : rest
     in trace (show v) v
  where
    r : l : rest = stack
    isOp = (`elem` ["^", "*", "/", "+", "-"])

--------------------------- TEST -------------------------
main :: IO ()
main =
  mapM_
    ( \s ->
        putStr (s <> "\n-->\n")
          >> (print . infixFromRPN)
            s
          >> putStrLn []
    )
    [ "3 4 2 * 1 5 - 2 3 ^ ^ / +",
      "1 2 + 3 4 + ^ 5 6 + ^",
      "1 4 + 5 3 + 2 3 * * *",
      "1 2 * 3 4 * *",
      "1 2 + 3 4 + +"
    ]

---------------------- SHOW INSTANCE ---------------------
instance Show Expression where
  show (Const x) = x
  show exp@(Exp l op r) = left <> " " <> op <> " " <> right
    where
      left
        | leftNeedParen = "( " <> show l <> " )"
        | otherwise = show l
      right
        | rightNeedParen = "( " <> show r <> " )"
        | otherwise = show r
      leftNeedParen =
        (leftPrec < opPrec)
          || ((leftPrec == opPrec) && rightAssoc exp)
      rightNeedParen =
        (rightPrec < opPrec)
          || ((rightPrec == opPrec) && leftAssoc exp)
      leftPrec = precedence l
      rightPrec = precedence r
      opPrec = precedence exp

leftAssoc :: Expression -> Bool
leftAssoc (Const _) = False
leftAssoc (Exp _ op _) = op `notElem` ["^", "*", "+"]

rightAssoc :: Expression -> Bool
rightAssoc (Const _) = False
rightAssoc (Exp _ op _) = op == "^"

precedence :: Expression -> Int
precedence (Const _) = 5
precedence (Exp _ op _)
  | op == "^" = 4
  | op `elem` ["*", "/"] = 3
  | op `elem` ["+", "-"] = 2
  | otherwise = 0


procedure main()
every rpn := ![
   "3 4 2 * 1 5 - 2 3 ^ ^ / +",  # reqd
   "1 2 + 3 4 + 5 6 + ^ ^",
   "1 2 + 3 4 + 5 6 + ^ ^",
   "1 2 + 3 4 + ^ 5 6 + ^"       # reqd
   ] do {
      printf("\nRPN   = %i\n",rpn)
      printf("infix = %i\n",RPN2Infix(rpn,show))
      show := 1 # turn off inner working display
      }
end

link printf

procedure RPN2Infix(expr,show)            #: RPN to Infix conversion
static oi
initial {
   oi := table([9,"'"])                   # precedence & associativity
   every oi[!"+-"]   := [2,"l"]             # 2L
   every oi[!"*/"]   := [3,"l"]             # 3L
   oi["^"]           := [4,"r"]             # 4R
   }

   show := if /show then printf else 1    # to show inner workings or not
   stack := []
   expr ? until pos(0) do {               # Reformat as a tree
      tab(many(' '))                         # consume previous seperator
      token := tab(upto(' ')|0)              # get token
      if token := numeric(token) then {      # ... numeric
         push(stack,oi[token]|||[token])
         show("pushed numeric   %i : %s\n",token,list2string(stack))
         }
      else {                                 # ... operator
         every b|a := pop(stack)             # pop & reverse operands
         pr := oi[token,1]
         as := oi[token,2]
         if a[1] < pr | (a[1] = pr & oi[token,2] == "r") then
            a[3] := sprintf("( %s )",a[3])
         if b[1] < pr | (b[1] == pr & oi[token,2] == "l") then
            b[3] := sprintf("( %s )",b[3])
         s := sprintf("%s %s %s",a[3],token,b[3])
         push(stack,[pr,as,s])               # stack [prec, assoc, expr]
         show("applied operator %s : %s\n",token,list2string(stack))
         }
   }

   if *stack ~= 1 then stop("Parser failure")
   return stack[1,3]
end

procedure list2string(L)                  #: format list as a string
   s := "[ "
   every x := !L do
      s ||:= ( if type(x) == "list" then list2string(x)
               else x) || " "
   return s || "]"
end


tokenize=: ' ' <;._1@, deb

ops=: ;:'+ - * / ^'
doOp=: plus`minus`times`divide`exponent`[email protected](ops&i.)
parse=:3 :0
  stack=: i.0 2
  for_token.tokenize y do.doOp token end.
  1{:: ,stack
)

parens=:4 :0
  if. y do. '( ',x,' )' else. x end.
)

NB. m: precedence, n: is right associative, y: token
op=:2 :0
  L=. m -   n
  R=. m - -.n
  smoutput;'operation: ';y
  'Lprec left Rprec right'=. ,_2{.stack
  expr=. ;(left parens L > Lprec);' ';y,' ';right parens R > Rprec
  stack=: (_2}.stack),m;expr
  smoutput stack
)

plus=:     2 op 0
minus=:    2 op 0
times=:    3 op 0
divide=:   3 op 0
exponent=: 4 op 1

push=:3 :0
  smoutput;'pushing: ';y
  stack=: stack,_;y
  smoutput stack
)


import java.util.Stack;

public class PostfixToInfix {

    public static void main(String[] args) {
        for (String e : new String[]{"3 4 2 * 1 5 - 2 3 ^ ^ / +",
            "1 2 + 3 4 + ^ 5 6 + ^"}) {
            System.out.printf("Postfix : %s%n", e);
            System.out.printf("Infix : %s%n", postfixToInfix(e));
            System.out.println();
        }
    }

    static String postfixToInfix(final String postfix) {

        class Expression {
            final static String ops = "-+/*^";

            String op, ex;
            int prec = 3;

            Expression(String e) {
                ex = e;
            }

            Expression(String e1, String e2, String o) {
                ex = String.format("%s %s %s", e1, o, e2);
                op = o;
                prec = ops.indexOf(o) / 2;
            }

            @Override
            public String toString() {
                return ex;
            }
        }

        Stack<Expression> expr = new Stack<>();

        for (String token : postfix.split("\\s+")) {
            char c = token.charAt(0);
            int idx = Expression.ops.indexOf(c);
            if (idx != -1 && token.length() == 1) {

                Expression r = expr.pop();
                Expression l = expr.pop();

                int opPrec = idx / 2;

                if (l.prec < opPrec || (l.prec == opPrec && c == '^'))
                    l.ex = '(' + l.ex + ')';

                if (r.prec < opPrec || (r.prec == opPrec && c != '^'))
                    r.ex = '(' + r.ex + ')';

                expr.push(new Expression(l.ex, r.ex, token));
            } else {
                expr.push(new Expression(token));
            }
            System.out.printf("%s -> %s%n", token, expr);
        }
        return expr.peek().ex;
    }
}


const Associativity = {
    /** a / b / c = (a / b) / c */
    left: 0,
    /** a ^ b ^ c = a ^ (b ^ c) */
    right: 1,
    /** a + b + c = (a + b) + c = a + (b + c) */
    both: 2,
};
const operators = {
    '+': { precedence: 2, associativity: Associativity.both },
    '-': { precedence: 2, associativity: Associativity.left },
    '*': { precedence: 3, associativity: Associativity.both },
    '/': { precedence: 3, associativity: Associativity.left },
    '^': { precedence: 4, associativity: Associativity.right },
};
class NumberNode {
    constructor(text) { this.text = text; }
    toString() { return this.text; }
}
class InfixNode {
    constructor(fnname, operands) {
        this.fnname = fnname;
        this.operands = operands;
    }
    toString(parentPrecedence = 0) {
        const op = operators[this.fnname];
        const leftAdd = op.associativity === Associativity.right ? 0.01 : 0;
        const rightAdd = op.associativity === Associativity.left ? 0.01 : 0;
        if (this.operands.length !== 2) throw Error("invalid operand count");
        const result = this.operands[0].toString(op.precedence + leftAdd)
            +` ${this.fnname} ${this.operands[1].toString(op.precedence + rightAdd)}`;
        if (parentPrecedence > op.precedence) return `( ${result} )`;
        else return result;
    }
}
function rpnToTree(tokens) {
    const stack = [];
    console.log(`input = ${tokens}`);
    for (const token of tokens.split(" ")) {
        if (token in operators) {
            const op = operators[token], arity = 2; // all of these operators take 2 arguments
            if (stack.length < arity) throw Error("stack error");
            stack.push(new InfixNode(token, stack.splice(stack.length - arity)));
        }
        else stack.push(new NumberNode(token));
        console.log(`read ${token}, stack = [${stack.join(", ")}]`);
    }
    if (stack.length !== 1) throw Error("stack error " + stack);
    return stack[0];
}
const tests = [
    ["3 4 2 * 1 5 - 2 3 ^ ^ / +", "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3"],
    ["1 2 + 3 4 + ^ 5 6 + ^", "( ( 1 + 2 ) ^ ( 3 + 4 ) ) ^ ( 5 + 6 )"],
    ["1 2 3 + +", "1 + 2 + 3"] // test associativity (1+(2+3)) == (1+2+3)
];
for (const [inp, oup] of tests) {
    const realOup = rpnToTree(inp).toString();
    console.log(realOup === oup ? "Correct!" : "Incorrect!");
}


function parseRPNstring(rpns)
    infix = []
    rpn = split(rpns)
    for tok in rpn
        if all(isnumber, tok)
            push!(infix, parse(Int, tok))
        else
            last = pop!(infix)
            prev = pop!(infix)
            push!(infix, Expr(:call, Symbol(tok), prev, last))
            println("Current step: $infix")
        end
    end
    infix
end

unany(s) = replace(string(s), r"Any\[:\((.+)\)\]", s"\1")

println("The final infix result: ", parseRPNstring("3 4 2 * 1 5 - 2 3 ^ ^ / +") |> unany, "\n")
println("The final infix result: ", parseRPNstring("1 2 + 3 4 + ^ 5 6 + ^") |> unany)


// version 1.2.0

import java.util.Stack

class Expression(var ex: String, val op: String = "", val prec: Int = 3) {

    constructor(e1: String, e2: String, o: String) :
        this("$e1 $o $e2", o, OPS.indexOf(o) / 2)

    override fun toString() = ex

    companion object {
        const val OPS = "-+/*^"
    }
}

fun postfixToInfix(postfix: String): String {
    val expr = Stack<Expression>()
    val rx = Regex("""\s+""")
    for (token in postfix.split(rx)) {
        val c = token[0]
        val idx = Expression.OPS.indexOf(c)
        if (idx != -1 && token.length == 1) {
            val r = expr.pop()
            val l = expr.pop()
            val opPrec = idx / 2
            if (l.prec < opPrec || (l.prec == opPrec && c == '^')) {
                l.ex = "(${l.ex})"
            }
            if (r.prec < opPrec || (r.prec == opPrec && c != '^')) {
                r.ex = "(${r.ex})"
            }
            expr.push(Expression(l.ex, r.ex, token))
        }
        else {
            expr.push(Expression(token))
        }
        println("$token -> $expr")
    }
    return expr.peek().ex
}

fun main(args: Array<String>) {
    val es = listOf(
        "3 4 2 * 1 5 - 2 3 ^ ^ / +",
        "1 2 + 3 4 + ^ 5 6 + ^"
    )
    for (e in es) {
        println("Postfix : $e")
        println("Infix : ${postfixToInfix(e)}\n")
    }
}


function tokenize(rpn)
    local out = {}
    local cnt = 0
    for word in rpn:gmatch("%S+") do
        table.insert(out, word)
        cnt = cnt + 1
    end
    return {tokens = out, pos = 1, size = cnt}
end

function advance(lex)
    if lex.pos <= lex.size then
        lex.pos = lex.pos + 1
        return true
    else
        return false
    end
end

function current(lex)
    return lex.tokens[lex.pos]
end

function isOperator(sym)
    return sym == '+' or sym == '-'
        or sym == '*' or sym == '/'
        or sym == '^'
end

function buildTree(lex)
    local stack = {}

    while lex.pos <= lex.size do
        local sym = current(lex)
        advance(lex)

        if isOperator(sym) then
            local b = table.remove(stack)
            local a = table.remove(stack)

            local t = {op=sym, left=a, right=b}
            table.insert(stack, t)
        else
            table.insert(stack, sym)
        end
    end

    return table.remove(stack)
end

function infix(tree)
    if type(tree) == "table" then
        local a = {}
        local b = {}

        if type(tree.left) == "table" then
            a = '(' .. infix(tree.left) .. ')'
        else
            a = tree.left
        end

        if type(tree.right) == "table" then
            b = '(' .. infix(tree.right) .. ')'
        else
            b = tree.right
        end

        return a .. ' ' .. tree.op .. ' ' .. b
    else
        return tree
    end
end

function convert(str)
    local lex = tokenize(str)
    local tree = buildTree(lex)
    print(infix(tree))
end

function main()
    convert("3 4 2 * 1 5 - 2 3 ^ ^ / +")
    convert("1 2 + 3 4 + ^ 5 6 + ^")
end

main()


Module Rpn_2_Infix {
	Rem Form 80,60
	function rpn_to_infix$(a$) {
		def m=0
		inventory precendence="-":=2,"+":=2,"*":=3,"/":=3,"^":=4
		dim token$()
		token$()=piece$(a$," ")
		l=len(token$())
		dim type(l)=0, right(l)=0, infix$(l)
		infix=-1
		for i=0 to  l-1
			if exist(precendence, token$(i)) then
				type(i)=precendence(token$(i))
				if type(i)=4 then right(i)=-1
			end if
			if type(i)=0 then
				infix++
				infix$(infix)=token$(i)
				type(infix)=100
			else
				if right(i) then
					if type(infix)<type(i) then infix$(infix)="("+infix$(infix)+")"
					if type(infix-1)<100 then infix$(infix-1)="("+infix$(infix-1)+")"
					infix$(infix-1)=infix$(infix-1)+token$(i)+infix$(infix)
				else
					if type(infix)<type(i) then infix$(infix)="("+infix$(infix)+")"
					if type(infix-1)<type(i) then
						infix$(infix-1)="("+infix$(infix-1)+")"+token$(i)+infix$(infix)
					else
						infix$(infix-1)=infix$(infix-1)+token$(i)+infix$(infix)
					end if
				end if
				type(infix-1)=type(i)
				infix--
			end if
			inf=each(infix$(),1, infix+1)
			while inf
				export$<=token$(i)+" ["+str$(inf^,"")+"] "+ array$(inf)+{
				}
				token$(i)=" "
			end while
		next i
		=infix$(0)
	}
	Global export$
	document export$
	example1=rpn_to_infix$("3 4 2 * 1 5 - 2 3 ^ ^ / +")="3+4*2/(1-5)^2^3"
	example2=rpn_to_infix$("1 2 + 3 4 + ^ 5 6 + ^")="((1+2)^(3+4))^(5+6)"
	\\ a test from Phix example
	example3=rpn_to_infix$("moon stars mud + * fire soup * ^")="(moon*(stars+mud))^(fire*soup)"
	Print example1, example2, example3
	Rem Print #-2, Export$
	ClipBoard Export$

}
Rpn_2_Infix


import tables, strutils

const nPrec = 9

let ops: Table[string, tuple[prec: int, rAssoc: bool]] =
  { "^": (4, true)
  , "*": (3, false)
  , "/": (3, false)
  , "+": (2, false)
  , "-": (2, false)
  }.toTable

proc parseRPN(e: string) =
  echo "postfix: ", e
  var stack = newSeq[tuple[prec: int, expr: string]]()

  for tok in e.split:
    echo "Token: ", tok
    if ops.hasKey tok:
      let op = ops[tok]
      let rhs = stack.pop
      var lhs = stack.pop

      if lhs.prec < op.prec or (lhs.prec == op.prec and op.rAssoc):
        lhs.expr = "(" & lhs.expr & ")"

      lhs.expr.add " " & tok & " "

      if rhs.prec < op.prec or (rhs.prec == op.prec and not op.rAssoc):
        lhs.expr.add "(" & rhs.expr & ")"
      else:
        lhs.expr.add rhs.expr

      lhs.prec = op.prec
      stack.add lhs
    else:
      stack.add((nPrec, tok))

    for f in stack:
      echo "    ", f.prec, " ", f.expr

  echo "infix: ", stack[0].expr

for test in ["3 4 2 * 1 5 - 2 3 ^ ^ / +", "1 2 + 3 4 + ^ 5 6 + ^"]:
  test.parseRPN


use strict;
use warnings;
use feature 'say';

my $number   = '[+-/$]?(?:\.\d+|\d+(?:\.\d*)?)';
my $operator = '[-+*/^]';

my @tests = ('1 2 + 3 4 + ^ 5 6 + ^', '3 4 2 * 1 5 - 2 3 ^ ^ / +');

for (@tests) {
    my(@elems,$n);
    $n = -1;
    while (
        s/
            \s* (?<left>$number)   # 1st operand (will be 'left'  in infix)
            \s+ (?<right>$number)  # 2nd operand (will be 'right' in infix)
            \s+ (?<op>$operator)   # operator
            (?:\s+|$)              # more to parse, or done?
         /
            ' '.('$'.++$n).' '     # placeholders
         /ex) {
            $elems[$n] = "($+{left}$+{op}$+{right})"  # infix expression
         }
    while (
        s/ (\$)(\d+)    # for each placeholder
         / $elems[$2]   # evaluate expression, substitute numeric value
         /ex
        ) { say }       # track progress
    say '=>' . substr($_,2,-2)."\n";
}


with javascript_semantics
bool show_workings = true

constant operators  = {"^","*","/","+","-"},
         precedence = { 4,  3,  3,  2,  2 },
         rassoc     = {'r', 0 ,'l', 0 ,'l'}

procedure parseRPN(string expr, expected)
    sequence stack = {},
             ops = split(expr)
    string lhs, rhs
    integer lprec,rprec
    printf(1,"Postfix input: %-32s%s", {expr,iff(show_workings?'\n':' ')})
    if length(ops)=0 then ?"error" return end if
    for i=1 to length(ops) do
        string op = ops[i]
        integer k = find(op,operators)
        if k=0 then
            stack = append(stack,{9,op})
        else
            if length(stack)<2 then ?"error" return end if
            {rprec,rhs} = stack[$]; stack = stack[1..$-1]
            {lprec,lhs} = stack[$]
            integer prec = precedence[k]
            integer assoc = rassoc[k]
            if lprec<prec or (lprec=prec and assoc='r') then
                lhs = "("&lhs&")"
            end if
            if rprec<prec or (rprec=prec and assoc='l') then
                rhs = "("&rhs&")"
            end if
            stack[$] = {prec,lhs&" "&op&" "&rhs}
        end if
        if show_workings then
            ?{op,stack}
        end if
    end for
    string res = stack[1][2]
    printf(1,"Infix result: %s [%s]\n", {res,iff(res=expected?"ok","**ERROR**")})
end procedure

parseRPN("3 4 2 * 1 5 - 2 3 ^ ^ / +","3 + 4 * 2 / (1 - 5) ^ 2 ^ 3")
show_workings = false
parseRPN("1 2 + 3 4 + ^ 5 6 + ^","((1 + 2) ^ (3 + 4)) ^ (5 + 6)")
parseRPN("1 2 + 3 4 + 5 6 + ^ ^","(1 + 2) ^ (3 + 4) ^ (5 + 6)")
parseRPN("moon stars mud + * fire soup * ^","(moon * (stars + mud)) ^ (fire * soup)")
parseRPN("3 4 ^ 2 9 ^ ^ 2 5 ^ ^","((3 ^ 4) ^ 2 ^ 9) ^ 2 ^ 5")
parseRPN("5 6 * * + +","error")
parseRPN("","error")
parseRPN("1 4 + 5 3 + 2 3 * * *","(1 + 4) * (5 + 3) * 2 * 3")
parseRPN("1 2 * 3 4 * *","1 * 2 * 3 * 4")
parseRPN("1 2 + 3 4 + +","1 + 2 + 3 + 4")
parseRPN("1 2 + 3 4 + ^","(1 + 2) ^ (3 + 4)")
parseRPN("5 6 ^ 7 ^","(5 ^ 6) ^ 7")
parseRPN("5 4 3 2 ^ ^ ^","5 ^ 4 ^ 3 ^ 2")
parseRPN("1 2 3 + +","1 + 2 + 3")
parseRPN("1 2 + 3 +","1 + 2 + 3")
parseRPN("1 2 3 ^ ^","1 ^ 2 ^ 3")
parseRPN("1 2 ^ 3 ^","(1 ^ 2) ^ 3")
parseRPN("1 1 - 3 +","1 - 1 + 3")
parseRPN("3 1 1 - +","3 + 1 - 1")           -- [txr says 3 + (1 - 1)]
parseRPN("1 2 3 + -","1 - (2 + 3)")
parseRPN("4 3 2 + +","4 + 3 + 2")
parseRPN("5 4 3 2 + + +","5 + 4 + 3 + 2")
parseRPN("5 4 3 2 * * *","5 * 4 * 3 * 2")
parseRPN("5 4 3 2 + - +","5 + 4 - (3 + 2)") -- [python says 5 + (4 - (3 + 2))]
parseRPN("3 4 5 * -","3 - 4 * 5")
parseRPN("3 4 5 - *","3 * (4 - 5)")         -- [python says (3 - 4) * 5] [!!flagged!!]
parseRPN("3 4 - 5 *","(3 - 4) * 5")
parseRPN("4 2 * 1 5 - +","4 * 2 + 1 - 5")   -- [python says 4 * 2 + (1 - 5)]
parseRPN("4 2 * 1 5 - 2 ^ /","4 * 2 / (1 - 5) ^ 2")
parseRPN("3 4 2 * 1 5 - 2 3 ^ ^ / +","3 + 4 * 2 / (1 - 5) ^ 2 ^ 3")