/* ARM assembly Raspberry PI  or android 32 bits */
/* program tonshan.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:          .asciz "Program 32 bits start \n"
szMessEndPgm:            .asciz "Program normal end.\n"
szMessError:             .asciz "\033[31mError  !!!\n"
szMessErrGen:            .asciz "Error end program.\n"
szMessOverflow:          .asciz "Overflow function modulo.\n"
szMessNoSolution:        .asciz "No solution.\n"
szCarriageReturn:        .asciz "\n"

/* datas message display */
szMessEntry:             .asciz "Number : @ modulo : @ ==> "
szMessResult:            .asciz "Racine 1 : @ Racine 2 : @  \n"

iNumberN:                .int 1030
iNumberP:                .int 10009

iNumberN1:               .int 1032
iNumberP1:               .int 10009

iNumberN2:               .int 44402
iNumberP2:               .int 100049

/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:               .skip 24
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                               // program start
    ldr r0,iAdrszMessStartPgm       // display start message
    bl affichageMess

    mov r0,#10
    mov r1,#13
    bl displayEntry                 // display entry number
    bl computeTonSha                // compute roots
    bl displayResult                // display roots

    mov r0,#56
    mov r1,#101
    bl displayEntry
    bl computeTonSha
    bl displayResult

    ldr r4,iAdriNumberN
    ldr r0,[r4]
    ldr r4,iAdriNumberP
    ldr r1,[r4]
    bl displayEntry
    bl computeTonSha
    bl displayResult

    ldr r4,iAdriNumberN1
    ldr r0,[r4]
    ldr r4,iAdriNumberP1
    ldr r1,[r4]
    bl displayEntry
    bl computeTonSha
    bcs 1f
    bl displayResult
1:
    ldr r4,iAdriNumberN2
    ldr r0,[r4]
    ldr r4,iAdriNumberP2
    ldr r1,[r4]
    bl displayEntry
    bl computeTonSha
    bl displayResult

    ldr r0,iAdrszMessEndPgm         // display end message
    bl affichageMess
    b 100f
99:                                 // display error message
    ldr r0,iAdrszMessError
    bl affichageMess
100:                                // standard end of the program
    mov r0, #0                      // return code
    mov r7, #EXIT                   // request to exit program
    svc 0                           // perform system call
iAdrszMessStartPgm:        .int szMessStartPgm
iAdrszMessEndPgm:          .int szMessEndPgm
iAdrszMessError:           .int szMessError
iAdrszMessNoSolution:      .int szMessNoSolution
iAdrszCarriageReturn:      .int szCarriageReturn
iAdriNumberN:              .int iNumberN
iAdriNumberP:              .int iNumberP
iAdriNumberN1:             .int iNumberN1
iAdriNumberP1:             .int iNumberP1
iAdriNumberN2:             .int iNumberN2
iAdriNumberP2:             .int iNumberP2

iAdrszMessResult:          .int szMessResult
iAdrsZoneConv:             .int sZoneConv

/******************************************************************/
/*     algorithm Tonelli–Shanks                                   */
/******************************************************************/
/* r0 contains number */
/* r1 contains modulus */
/* r0 return root 1 */
/* r1 return root 2 */
computeTonSha:
    push {r2-r12,lr}

    mov r9,r0               // save number
    mov r10,r1              // save modulo p
    mov r2,r10
    sub r1,r2,#1
    lsr r1,r1,#1
    bl moduloPuR32
    cmp r0,#1
    bne 20f
    sub r5,r10,#1
    mov r6,#1               // s
1:
    lsr r5,r5,#1            // div by 2
    tst r5,#1                // even ?
    addeq r6,#1
    beq 1b                  // and loop
                            // r5 = q
    cmp r6,#1               // s = 1 ?
    bne 3f
    add r1,r10,#1            // compute root 1
    lsr r1,r1,#2            // p + 1 / 4
    mov r0,r9               // n
    mov r2,r10              // p
    bl moduloPuR32
    neg r1,r0               // compute root 2 = - root 1
    b 100f                  // and end
3:
    mov r7,#3               // z
4:
    mov r0,r7
    mov r2,r10              //  p
    sub r1,r2,#1
    lsr r1,r1,#1             // power = p - 1 / 2
    bl moduloPuR32
    cmp r0,#1
    addeq r7,#2
    beq 4b
    cmp r0,#0
    addeq r7,#2
    beq 4b
    mov r0,r7               // z
    mov r1,r5               // q
    mov r2,r10              // p
    bl moduloPuR32
    mov r12,r0              // c = z pow q mod p

    add r1,r5,#1             // = q +1
    lsr r1,r1,#1             // div 2
    mov r0,r9               // n
    mov r2,r10              // p
    bl moduloPuR32
    mov r4,r0               // r =  n puis (q+1)/2 mod p

    mov r0,r9               // n
    mov r1,r5               // = q
    mov r2,r10              // p
    bl moduloPuR32
    mov r5,r0               // reuse r5 = t = n pow q mod p

8:                          // begin loop
    cmp r5,#1
    beq 10f
    mov r0,r5               // t
    mov r1,r6               // m
    mov r2,r10              // p
    bl searchI              // search i for t puis 2 puis i = 1 mod p
    cmp r0,#-1               // not find -> no solution
    beq 20f
    mov r9,r0               // i
    sub r8,r6,r0            // compute b
    sub r8,r8,#1             // m - i - 1
    mov r1,#1
    lsl r1,r1,r8
    mov r0,r12
    mov r2,r10              // p
    bl moduloPuR32
    mov r7,r0               // b = c puis 2 puis 2 puis m-i-1  à verifier

    umull r0,r1,r7,r4            // r = r * b mod p
    mov r2,r10
    bl division32R
    mov r4,r2               // r mod p
    umull r0,r1,r7,r7
    mov r2,r10
    bl division32R
    mov r12,r2              // c mod p

    umull r0,r1,r5,r12
    mov r2,r10
    bl division32R
    mov r5,r2               // t mod p

    mov r6,r9               // m = i
    b 8b
9:

10:
    mov r0,r4               // r0 return root 1
    sub r1,r10,r0           //  r1 return root 2
    cmn r0,#0               // carry à zero roots ok
    b 100f
20:
    ldr r0,iAdrszMessNoSolution
    bl affichageMess

    mov r0,#0
    mov r1,#0
    cmp r0,#0               // carry to 1 No solution
100:
    pop {r2-r12,lr}         // restaur registers
    bx lr                   // return
/******************************************************************/
/*     search i                                               */
/******************************************************************/
// r0 contains t
// r1 contains maxi
// r2 contains modulo
// r0 return i
searchI:
    push {r1-r6,lr}

    mov r4,r0               // t
    mov r6,r1               // m
    mov r3,#1               // i
1:
    mov r5,#1
    lsl r5,r5,r3            // compute 2 power i

    mov r0,r4
    mov r1,r5
    bl moduloPuR32          // compute t pow 2 pow i mod p
    cmp r0,#1               // = 1 ?
    beq 3f                  // yes it is ok
    add r3,r3,#1            // next i
    cmp r3,r6
    blt 1b                  // loop
    mov r0,#-1              // not find
    b 100f
3:
    mov r0,r3              // return i
100:
    pop {r1-r6,lr}         // restaur registers
    bx lr                  // return
/******************************************************************/
/*     display numbers                                             */
/******************************************************************/
/* r0 contains number */
/* r1 contains modulo */
displayEntry:
    push {r0-r3,lr}
    mov r2,r1                  // root 2
    ldr r1,iAdrsZoneConv       // convert root 1 in r0
    bl conversion10S           // convert ascii string
    ldr r0,iAdrszMessEntry
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    mov r3,r0
    mov r0,r2                  // racine 2
    ldr r1,iAdrsZoneConv
    bl conversion10S           // convert ascii string
    mov r0,r3
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    bl affichageMess
100:
    pop {r0-r3,lr}             // restaur registers
    bx lr                      // return
iAdrszMessEntry:   .int szMessEntry
/******************************************************************/
/*     display roots                                               */
/******************************************************************/
/* r0 contains root 1 */
/* r1 contains root 2 */
displayResult:
    push {r1-r3,lr}
    mov r2,r1                  // root 2
    ldr r1,iAdrsZoneConv       // convert root 1 in r0
    bl conversion10S           // convert ascii string
    ldr r0,iAdrszMessResult
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    mov r3,r0
    mov r0,r2                  // racine 2
    ldr r1,iAdrsZoneConv
    bl conversion10S           // convert ascii string
    mov r0,r3
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc      // and put in message
    bl affichageMess
100:

    pop {r1-r3,lr}             // restaur registers
    bx lr                      // return
/********************************************************/
/*   Calcul modulo de b puissance e modulo m  */
/*    Exemple 4 puissance 13 modulo 497 = 445         */
/*                                             */
/********************************************************/
/* r0  nombre  */
/* r1 exposant */
/* r2 modulo   */
/* r0 return result  */
moduloPuR32:
    push {r1-r7,lr}    @ save registers
    cmp r0,#0          @ verif <> zero
    beq 90f
    cmp r1,#0          @ verif <> zero
    moveq r0,#0
    beq 90f
    cmp r2,#0          @ verif <> zero
    moveq r0,#0
    beq 90f            @
1:
    mov r4,r2          @ save modulo
    mov r5,r1          @ save exposant
    mov r6,r0          @ save base
    mov r3,#1          @ start result

    mov r1,#0          @ division de r0,r1 par r2
    bl division32R
    mov r6,r2          @ base <- remainder
2:
    tst r5,#1          @  exposant even or odd
    beq 3f
    umull r0,r1,r6,r3
    mov r2,r4
    bl division32R
    mov r3,r2          @ result <- remainder
3:
    umull r0,r1,r6,r6
    mov r2,r4
    bl division32R
    mov r6,r2          @ base <- remainder

    lsr r5,#1          @ left shift 1 bit
    cmp r5,#0          @ end ?
    bne 2b
    mov r0,r3
90:
    cmn r0,#0          @ no error
100:                   @ fin standard de la fonction
    pop {r1-r7,lr}     @ restaur des registres
    bx lr              @ retour de la fonction en utilisant lr

/***************************************************/
/*   division number 64 bits in 2 registers by number 32 bits */
/***************************************************/
/* r0 contains lower part dividende   */
/* r1 contains upper part dividende   */
/* r2 contains divisor   */
/* r0 return lower part quotient    */
/* r1 return upper part quotient    */
/* r2 return remainder               */
division32R:
    push {r3-r9,lr}    @ save registers
    mov r6,#0          @ init upper upper part remainder  !!
    mov r7,r1          @ init upper part remainder with upper part dividende
    mov r8,r0          @ init lower part remainder with lower part dividende
    mov r9,#0          @ upper part quotient
    mov r4,#0          @ lower part quotient
    mov r5,#32         @ bits number
1:                     @ begin loop
    lsl r6,#1          @ shift upper upper part remainder
    lsls r7,#1         @ shift upper  part remainder
    orrcs r6,#1
    lsls r8,#1         @ shift lower  part remainder
    orrcs r7,#1
    lsls r4,#1         @ shift lower part quotient
    lsl r9,#1          @ shift upper part quotient
    orrcs r9,#1
                       @ divisor sustract  upper  part remainder
    subs r7,r2
    sbcs  r6,#0        @ and substract carry
    bmi 2f             @ négative ?

                       @ positive or equal
    orr r4,#1          @ 1 -> right bit quotient
    b 3f
2:                     @ negative
    orr r4,#0          @ 0 -> right bit quotient
    adds r7,r2         @ and restaur remainder
    adc  r6,#0
3:
    subs r5,#1         @ decrement bit size
    bgt 1b             @ end ?
    mov r0,r4          @ lower part quotient
    mov r1,r9          @ upper part quotient
    mov r2,r7          @ remainder
100:                   @ function end
    pop {r3-r9,lr}     @ restaur registers
    bx lr
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


(defun preorder (node f)
  (when node
    (funcall f (first node))
    (preorder (second node) f)
    (preorder (third node)  f)))

(defun inorder (node f)
  (when node
    (inorder (second node) f)
    (funcall f (first node))
    (inorder (third node)  f)))

(defun postorder (node f)
  (when node
    (postorder (second node) f)
    (postorder (third node)  f)
    (funcall f (first node))))

(defun level-order (node f)
  (loop with level = (list node)
        while level
        do
    (setf level (loop for node in level
                      when node
                        do (funcall f (first node))
                        and collect (second node)
                        and collect (third node)))))

(defparameter *tree* '(1 (2 (4 (7))
                            (5))
                         (3 (6 (8)
                               (9)))))

(defun show (traversal-function)
  (format t "~&~(~A~):~12,0T" traversal-function)
  (funcall traversal-function *tree* (lambda (value) (format t " ~A" value))))

(map nil #'show '(preorder inorder postorder level-order))


defmodule Topological do
  def sort(library) do
    g = :digraph.new
    Enum.each(library, fn {l,deps} ->
      :digraph.add_vertex(g,l)           # noop if library already added
      Enum.each(deps, fn d -> add_dependency(g,l,d) end)
    end)
    if t = :digraph_utils.topsort(g) do
      print_path(t)
    else
      IO.puts "Unsortable contains circular dependencies:"
      Enum.each(:digraph.vertices(g), fn v ->
        if vs = :digraph.get_short_cycle(g,v), do: print_path(vs)
      end)
    end
  end

  defp print_path(l), do: IO.puts Enum.join(l, " -> ")

  defp add_dependency(_g,l,l), do: :ok
  defp add_dependency(g,l,d) do
    :digraph.add_vertex(g,d)   # noop if dependency already added
    :digraph.add_edge(g,d,l)   # Dependencies represented as an edge d -> l
  end
end

libraries = [
  des_system_lib:   ~w[std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee]a,
  dw01:             ~w[ieee dw01 dware gtech]a,
  dw02:             ~w[ieee dw02 dware]a,
  dw03:             ~w[std synopsys dware dw03 dw02 dw01 ieee gtech]a,
  dw04:             ~w[dw04 ieee dw01 dware gtech]a,
  dw05:             ~w[dw05 ieee dware]a,
  dw06:             ~w[dw06 ieee dware]a,
  dw07:             ~w[ieee dware]a,
  dware:            ~w[ieee dware]a,
  gtech:            ~w[ieee gtech]a,
  ramlib:           ~w[std ieee]a,
  std_cell_lib:     ~w[ieee std_cell_lib]a,
  synopsys:         []
]
Topological.sort(libraries)

IO.puts ""
bad_libraries = Keyword.update!(libraries, :dw01, &[:dw04 | &1])
Topological.sort(bad_libraries)


-module(topological_sort).
-compile(export_all).

-define(LIBRARIES,
        [{des_system_lib,   [std, synopsys, std_cell_lib, des_system_lib, dw02, dw01, ramlib, ieee]},
         {dw01,             [ieee, dw01, dware, gtech]},
         {dw02,             [ieee, dw02, dware]},
         {dw03,             [std, synopsys, dware, dw03, dw02, dw01, ieee, gtech]},
         {dw04,             [dw04, ieee, dw01, dware, gtech]},
         {dw05,             [dw05, ieee, dware]},
         {dw06,             [dw06, ieee, dware]},
         {dw07,             [ieee, dware]},
         {dware,            [ieee, dware]},
         {gtech,            [ieee, gtech]},
         {ramlib,           [std, ieee]},
         {std_cell_lib,     [ieee, std_cell_lib]},
         {synopsys,         []}]).

-define(BAD_LIBRARIES,
        [{des_system_lib,   [std, synopsys, std_cell_lib, des_system_lib, dw02, dw01, ramlib, ieee]},
         {dw01,             [ieee, dw01, dw04, dware, gtech]},
         {dw02,             [ieee, dw02, dware]},
         {dw03,             [std, synopsys, dware, dw03, dw02, dw01, ieee, gtech]},
         {dw04,             [dw04, ieee, dw01, dware, gtech]},
         {dw05,             [dw05, ieee, dware]},
         {dw06,             [dw06, ieee, dware]},
         {dw07,             [ieee, dware]},
         {dware,            [ieee, dware]},
         {gtech,            [ieee, gtech]},
         {ramlib,           [std, ieee]},
         {std_cell_lib,     [ieee, std_cell_lib]},
         {synopsys,         []}]).

main() ->
    top_sort(?LIBRARIES),
    top_sort(?BAD_LIBRARIES).

top_sort(Library) ->
    G = digraph:new(),
    lists:foreach(fun ({L,Deps}) ->
                          digraph:add_vertex(G,L), % noop if library already added
                          lists:foreach(fun (D) ->
                                                add_dependency(G,L,D)
                                        end, Deps)
                  end, Library),
    T = digraph_utils:topsort(G),
    case T of
        false ->
            io:format("Unsortable contains circular dependencies:~n",[]),
            lists:foreach(fun (V) ->
                                  case digraph:get_short_cycle(G,V) of
                                      false ->
                                          ok;
                                      Vs ->
                                          print_path(Vs)
                                  end
                          end, digraph:vertices(G));
        _ ->
            print_path(T)
    end.

print_path(L) ->
            lists:foreach(fun (V) -> io:format("~s -> ",[V]) end,
                          lists:sublist(L,length(L)-1)),
            io:format("~s~n",[lists:last(L)]).

add_dependency(_G,_L,_L) ->
    ok;
add_dependency(G,L,D) ->
    digraph:add_vertex(G,D), % noop if dependency already added
    digraph:add_edge(G,D,L). % Dependencies represented as an edge D -> L


#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>

uint64_t modpow(uint64_t a, uint64_t b, uint64_t n) {
    uint64_t x = 1, y = a;
    while (b > 0) {
        if (b % 2 == 1) {
            x = (x * y) % n; // multiplying with base
        }
        y = (y * y) % n; // squaring the base
        b /= 2;
    }
    return x % n;
}

struct Solution {
    uint64_t root1, root2;
    bool exists;
};

struct Solution makeSolution(uint64_t root1, uint64_t root2, bool exists) {
    struct Solution sol;
    sol.root1 = root1;
    sol.root2 = root2;
    sol.exists = exists;
    return sol;
}

struct Solution ts(uint64_t n, uint64_t p) {
    uint64_t q = p - 1;
    uint64_t ss = 0;
    uint64_t z = 2;
    uint64_t c, r, t, m;

    if (modpow(n, (p - 1) / 2, p) != 1) {
        return makeSolution(0, 0, false);
    }

    while ((q & 1) == 0) {
        ss += 1;
        q >>= 1;
    }

    if (ss == 1) {
        uint64_t r1 = modpow(n, (p + 1) / 4, p);
        return makeSolution(r1, p - r1, true);
    }

    while (modpow(z, (p - 1) / 2, p) != p - 1) {
        z++;
    }

    c = modpow(z, q, p);
    r = modpow(n, (q + 1) / 2, p);
    t = modpow(n, q, p);
    m = ss;

    while (true) {
        uint64_t i = 0, zz = t;
        uint64_t b = c, e;
        if (t == 1) {
            return makeSolution(r, p - r, true);
        }
        while (zz != 1 && i < (m - 1)) {
            zz = zz * zz % p;
            i++;
        }
        e = m - i - 1;
        while (e > 0) {
            b = b * b % p;
            e--;
        }
        r = r * b % p;
        c = b * b % p;
        t = t * c % p;
        m = i;
    }
}

void test(uint64_t n, uint64_t p) {
    struct Solution sol = ts(n, p);
    printf("n = %llu\n", n);
    printf("p = %llu\n", p);
    if (sol.exists) {
        printf("root1 = %llu\n", sol.root1);
        printf("root2 = %llu\n", sol.root2);
    } else {
        printf("No solution exists\n");
    }
    printf("\n");
}

int main() {
    test(10, 13);
    test(56, 101);
    test(1030, 10009);
    test(1032, 10009);
    test(44402, 100049);

    return 0;
}


Require Import Utf8.
Require Import List.

Unset Elimination Schemes.

(* Rose tree, with numbers on nodes *)
Inductive tree := Tree { value : nat ; children : list tree }.

Fixpoint height (t: tree) : nat :=
  1 + fold_left (λ n t, max n (height t)) (children t) 0.

Example leaf n : tree := {| value := n ; children := nil |}.

Example t2 : tree := {| value := 2 ; children := {| value := 4 ; children := leaf 7 :: nil |} :: leaf 5 :: nil |}.

Example t3 : tree := {| value := 3 ; children := {| value := 6 ; children := leaf 8 :: leaf 9 :: nil |} :: nil |}.

Example t9 : tree := {| value := 1 ; children := t2 :: t3 :: nil |}.

Fixpoint preorder (t: tree) : list nat :=
  let '{| value := n ; children := c |} := t in
  n :: flat_map preorder c.

Fixpoint inorder (t: tree) : list nat :=
  let '{| value := n ; children := c |} := t in
  match c with
  | nil => n :: nil
  | ℓ :: r => inorder ℓ ++ n :: flat_map inorder r
  end.

Fixpoint postorder (t: tree) : list nat :=
  let '{| value := n ; children := c |} := t in
  flat_map postorder c ++ n :: nil.

(* Auxiliary function for levelorder, which operates on forests *)
(* Since the recursion is tricky, it relies on a fuel parameter which obviously decreases. *)
Fixpoint levelorder_forest (fuel: nat) (f: list tree) : list nat:=
  match fuel with
  | O => nil
  | S fuel' =>
    let '(p, f) := fold_right (λ t r, let '(x, f) := r in (value t :: x, children t ++ f) ) (nil, nil) f in
    p ++ levelorder_forest fuel' f
  end.

Definition levelorder (t: tree) : list nat :=
  levelorder_forest (height t) (t :: nil).

Compute preorder t9.
Compute inorder t9.
Compute postorder t9.
Compute levelorder t9.


variable nodes 0 nodes ! \ linked list of nodes

: node. ( body -- )
    body> >name name>string type ;

: nodeps ( body -- )
    \ the word referenced by body has no (more) dependencies to resolve
    ['] drop over ! node. space ;

: processing ( body1 ... bodyn body -- body1 ... bodyn )
    \ the word referenced by body is in the middle of resolving dependencies
    2dup <> if \ unless it is a self-reference (see task description)
	['] drop over !
	." (cycle: " dup node. >r 1 begin \ print the cycle
	    dup pick dup [email protected] <> while
		space node. 1+ repeat
	." ) " 2drop r>
	then drop ;

: >processing ( body -- body )
    ['] processing over ! ;

: node ( "name" -- )
    \ define node "name" and initialize it to having no dependences
    create
    ['] nodeps , \ on definition, a node has no dependencies
    nodes @ , lastxt nodes ! \ linked list of nodes
  does> ( -- )
    dup @ execute ; \ perform xt associated with node

: define-nodes ( "names" <newline> -- )
    \ define all the names that don't exist yet as nodes
    begin
	parse-name dup while
	    2dup find-name 0= if
		2dup nextname node then
	    2drop repeat
    2drop ;

: deps ( "name" "deps" <newline> -- )
    \ name is after deps.  Implementation: Define missing nodes, then
    \ define a colon definition for
    >in @ define-nodes >in !
    ' :noname ]] >processing [[ source >in @ /string evaluate ]] nodeps ; [[
    swap >body ! 0 parse 2drop ;

: all-nodes ( -- )
    \ call all nodes, and they then print their dependences and themselves
    nodes begin
	@ dup while
	    dup execute
	    >body cell+ repeat
    drop ;

deps des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
deps dw01           ieee dw01 dware gtech
deps dw02           ieee dw02 dware
deps dw03           std synopsys dware dw03 dw02 dw01 ieee gtech
deps dw04           dw04 ieee dw01 dware gtech
deps dw05           dw05 ieee dware
deps dw06           dw06 ieee dware
deps dw07           ieee dware
deps dware          ieee dware
deps gtech          ieee gtech
deps ramlib         std ieee
deps std_cell_lib   ieee std_cell_lib
deps synopsys
\ to test the cycle recognition (overwrites dependences for dw1 above)
deps dw01           ieee dw01 dware gtech dw04

all-nodes


      SUBROUTINE TSORT(NL,ND,IDEP,IORD,IPOS,NO)
      IMPLICIT NONE
      INTEGER NL,ND,NO,IDEP(ND,2),IORD(NL),IPOS(NL),I,J,K,IL,IR,IPL,IPR
      DO 10 I=1,NL
      IORD(I)=I
   10 IPOS(I)=I
      K=1
   20 J=K
      K=NL+1
      DO 30 I=1,ND
      IL=IDEP(I,1)
      IR=IDEP(I,2)
      IPL=IPOS(IL)
      IPR=IPOS(IR)
      IF(IL.EQ.IR .OR. IPL.GE.K .OR. IPL.LT.J .OR. IPR.LT.J) GO TO 30
      K=K-1
      IPOS(IORD(K))=IPL
      IPOS(IL)=K
      IORD(IPL)=IORD(K)
      IORD(K)=IL
   30 CONTINUE
      IF(K.GT.J) GO TO 20
      NO=J-1
      END


using System;
using System.Collections.Generic;
using System.Numerics;

namespace TonelliShanks {
    class Solution {
        private readonly BigInteger root1, root2;
        private readonly bool exists;

        public Solution(BigInteger root1, BigInteger root2, bool exists) {
            this.root1 = root1;
            this.root2 = root2;
            this.exists = exists;
        }

        public BigInteger Root1() {
            return root1;
        }

        public BigInteger Root2() {
            return root2;
        }

        public bool Exists() {
            return exists;
        }
    }

    class Program {
        static Solution Ts(BigInteger n, BigInteger p) {
            if (BigInteger.ModPow(n, (p - 1) / 2, p) != 1) {
                return new Solution(0, 0, false);
            }

            BigInteger q = p - 1;
            BigInteger ss = 0;
            while ((q & 1) == 0) {
                ss = ss + 1;
                q = q >> 1;
            }

            if (ss == 1) {
                BigInteger r1 = BigInteger.ModPow(n, (p + 1) / 4, p);
                return new Solution(r1, p - r1, true);
            }

            BigInteger z = 2;
            while (BigInteger.ModPow(z, (p - 1) / 2, p) != p - 1) {
                z = z + 1;
            }
            BigInteger c = BigInteger.ModPow(z, q, p);
            BigInteger r = BigInteger.ModPow(n, (q + 1) / 2, p);
            BigInteger t = BigInteger.ModPow(n, q, p);
            BigInteger m = ss;

            while (true) {
                if (t == 1) {
                    return new Solution(r, p - r, true);
                }
                BigInteger i = 0;
                BigInteger zz = t;
                while (zz != 1 && i < (m - 1)) {
                    zz = zz * zz % p;
                    i = i + 1;
                }
                BigInteger b = c;
                BigInteger e = m - i - 1;
                while (e > 0) {
                    b = b * b % p;
                    e = e - 1;
                }
                r = r * b % p;
                c = b * b % p;
                t = t * c % p;
                m = i;
            }
        }

        static void Main(string[] args) {
            List<Tuple<long, long>> pairs = new List<Tuple<long, long>>() {
                new Tuple<long, long>(10, 13),
                new Tuple<long, long>(56, 101),
                new Tuple<long, long>(1030, 10009),
                new Tuple<long, long>(1032, 10009),
                new Tuple<long, long>(44402, 100049),
                new Tuple<long, long>(665820697, 1000000009),
                new Tuple<long, long>(881398088036, 1000000000039),
            };

            foreach (var pair in pairs) {
                Solution sol = Ts(pair.Item1, pair.Item2);
                Console.WriteLine("n = {0}", pair.Item1);
                Console.WriteLine("p = {0}", pair.Item2);
                if (sol.Exists()) {
                    Console.WriteLine("root1 = {0}", sol.Root1());
                    Console.WriteLine("root2 = {0}", sol.Root2());
                } else {
                    Console.WriteLine("No solution exists");
                }
                Console.WriteLine();
            }

            BigInteger bn = BigInteger.Parse("41660815127637347468140745042827704103445750172002");
            BigInteger bp = BigInteger.Pow(10, 50) + 577;
            Solution bsol = Ts(bn, bp);
            Console.WriteLine("n = {0}", bn);
            Console.WriteLine("p = {0}", bp);
            if (bsol.Exists()) {
                Console.WriteLine("root1 = {0}", bsol.Root1());
                Console.WriteLine("root2 = {0}", bsol.Root2());
            } else {
                Console.WriteLine("No solution exists");
            }
        }
    }
}


class Node(T)
  property left : Nil | Node(T)
  property right : Nil | Node(T)
  property data : T

  def initialize(@data, @left = nil, @right = nil)
  end

  def preorder_traverse
    print " #{data}"
    if left = @left
      left.preorder_traverse
    end
    if right = @right
      right.preorder_traverse
    end
  end

  def inorder_traverse
    if left = @left
      left.inorder_traverse
    end
    print " #{data}"
    if right = @right
      right.inorder_traverse
    end
  end

  def postorder_traverse
    if left = @left
      left.postorder_traverse
    end
    if right = @right
      right.postorder_traverse
    end
    print " #{data}"
  end

  def levelorder_traverse
    queue = Array(Node(T)).new
    queue << self

    until queue.size <= 0
      node = queue.shift

      unless node
        next
      end

      print " #{node.data}"

      if left = node.left
        queue << left
      end
      if right = node.right
        queue << right
      end
    end
  end
end

tree = Node(Int32).new(1,
  Node(Int32).new(2,
    Node(Int32).new(4,
      Node(Int32).new(7)),
    Node(Int32).new(5)),
  Node(Int32).new(3,
    Node(Int32).new(6,
      Node(Int32).new(8),
      Node(Int32).new(9))))

print "preorder:   "
tree.preorder_traverse
print "\ninorder:    "
tree.inorder_traverse
print "\npostorder:  "
tree.postorder_traverse
print "\nlevelorder: "
tree.levelorder_traverse
puts


def topsort( graph ) =
  val L = seq()
  val S = seq()
  val g = dict( graph )

  for (v, es) <- g
    g(v) = seq( es )

  for (v, es) <- g if es.isEmpty()
    S.append( v )

  while not S.isEmpty()
    val n = S.remove( 0 )
    L.append( n )

    for (m, es) <- g if n in es
      if (es -= n).isEmpty()
        S.append( m )

  for (v, es) <- g
    if not es.isEmpty()
      return None

  Some( L.toList() )

dependencies = '''
  des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
  dw01             ieee dw01 dware gtech
  dw02             ieee dw02 dware
  dw03             std synopsys dware dw03 dw02 dw01 ieee gtech
  dw04             dw04 ieee dw01 dware gtech
  dw05             dw05 ieee dware
  dw06             dw06 ieee dware
  dw07             ieee dware
  dware            ieee dware
  gtech            ieee gtech
  ramlib           std ieee
  std_cell_lib     ieee std_cell_lib
  synopsys
  '''

// convert dependencies data into a directed graph
graph = dict()
deps = set()

for l <- WrappedString( dependencies ).lines() if l.trim() != ''
  case list(l.trim().split('\\s+')) of
    [a] -> graph(a) = []
    h:t ->
      d = set( t )
      d -= h                  // remove self dependencies
      graph(h) = d
      deps ++= t

// add graph vertices for dependencies not appearing in left column
for e <- deps if e not in graph
  graph(e) = []

case topsort( graph ) of
  None -> println( 'un-orderable' )
  Some( ordering ) -> println( ordering )


package main

import (
    "fmt"
    "strings"
)

var data = `
LIBRARY          LIBRARY DEPENDENCIES
=======          ====================
des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
dw01             ieee dw01 dware gtech
dw02             ieee dw02 dware
dw03             std synopsys dware dw03 dw02 dw01 ieee gtech
dw04             dw04 ieee dw01 dware gtech
dw05             dw05 ieee dware
dw06             dw06 ieee dware
dw07             ieee dware
dware            ieee dware
gtech            ieee gtech
ramlib           std ieee
std_cell_lib     ieee std_cell_lib
synopsys         `

func main() {
    g, in, err := parseLibComp(data)
    if err != nil {
        fmt.Println(err)
        return
    }
    order, cyclic := topSortKahn(g, in)
    if cyclic != nil {
        fmt.Println("Cyclic:", cyclic)
        return
    }
    fmt.Println("Order:", order)
}

type graph map[string][]string
type inDegree map[string]int

// parseLibComp parses the text format of the task and returns a graph
// representation and a list of the in-degrees of each node.  The returned graph
// represents compile order rather than dependency order.  That is, for each map
// map key n, the map elements are libraries that depend on n being compiled
// first.
func parseLibComp(data string) (g graph, in inDegree, err error) {
    // small sanity check on input
    lines := strings.Split(data, "\n")
    if len(lines) < 3 || !strings.HasPrefix(lines[2], "=") {
        return nil, nil, fmt.Errorf("data format")
    }
    // toss header lines
    lines = lines[3:]
    // scan and interpret input, build graph
    g = graph{}
    in = inDegree{}
    for _, line := range lines {
        libs := strings.Fields(line)
        if len(libs) == 0 {
            continue // allow blank lines
        }
        lib := libs[0]
        g[lib] = g[lib]
        for _, dep := range libs[1:] {
            in[dep] = in[dep]
            if dep == lib {
                continue // ignore self dependencies
            }
            successors := g[dep]
            for i := 0; ; i++ {
                if i == len(successors) {
                    g[dep] = append(successors, lib)
                    in[lib]++
                    break
                }
                if dep == successors[i] {
                    break // ignore duplicate dependencies
                }
            }
        }
    }
    return g, in, nil
}

// General purpose topological sort, not specific to the application of
// library dependencies.  Adapted from Wikipedia pseudo code, one main
// difference here is that this function does not consume the input graph.
// WP refers to incoming edges, but does not really need them fully represented.
// A count of incoming edges, or the in-degree of each node is enough.  Also,
// WP stops at cycle detection and doesn't output information about the cycle.
// A little extra code at the end of this function recovers the cyclic nodes.
func topSortKahn(g graph, in inDegree) (order, cyclic []string) {
    var L, S []string
    // rem for "remaining edges," this function makes a local copy of the
    // in-degrees and consumes that instead of consuming an input.
    rem := inDegree{}
    for n, d := range in {
        if d == 0 {
            // accumulate "set of all nodes with no incoming edges"
            S = append(S, n)
        } else {
            // initialize rem from in-degree
            rem[n] = d
        }
    }
    for len(S) > 0 {
        last := len(S) - 1 // "remove a node n from S"
        n := S[last]
        S = S[:last]
        L = append(L, n) // "add n to tail of L"
        for _, m := range g[n] {
            // WP pseudo code reads "for each node m..." but it means for each
            // node m *remaining in the graph.*  We consume rem rather than
            // the graph, so "remaining in the graph" for us means rem[m] > 0.
            if rem[m] > 0 {
                rem[m]--         // "remove edge from the graph"
                if rem[m] == 0 { // if "m has no other incoming edges"
                    S = append(S, m) // "insert m into S"
                }
            }
        }
    }
    // "If graph has edges," for us means a value in rem is > 0.
    for c, in := range rem {
        if in > 0 {
            // recover cyclic nodes
            for _, nb := range g[c] {
                if rem[nb] > 0 {
                    cyclic = append(cyclic, c)
                    break
                }
            }
        }
    }
    if len(cyclic) > 0 {
        return nil, cyclic
    }
    return L, nil
}


(defn find-first
 " Finds first element of collection that satisifies predicate function pred "
  [pred coll]
  (first (filter pred coll)))

(defn modpow
  " b^e mod m (using Java which solves some cases the pure clojure method has to be modified to tackle--i.e. with large b & e and
    calculation simplications when gcd(b, m) == 1 and gcd(e, m) == 1) "
  [b e m]
  (.modPow (biginteger b) (biginteger e) (biginteger m)))

(defn legendre [a p]
  (modpow a (quot (dec p) 2) p)
)

(defn tonelli [n p]
  " Following Wikipedia https://en.wikipedia.org/wiki/Tonelli%E2%80%93Shanks_algorithm "
  (assert (= (legendre n p) 1) "not a square (mod p)")
  (loop [q (dec p)                                                  ; Step 1 in Wikipedia
         s 0]
    (if (zero? (rem q 2))
      (recur (quot q 2) (inc s))
      (if (= s 1)
        (modpow n (quot (inc p) 4) p)
        (let [z (find-first #(= (dec p) (legendre % p)) (range 2 p))] ; Step 2 in Wikipedia
          (loop [
                 M s
                 c (modpow z q p)
                 t (modpow n q p)
                 R (modpow n (quot (inc q) 2) p)]
            (if (= t 1)
              R
              (let [i (long (find-first #(= 1 (modpow t (bit-shift-left 1 %) p)) (range 1 M))) ; Step 3
                    b (modpow c (bit-shift-left 1 (- M i 1)) p)
                    M i
                    c (modpow b 2 p)
                    t (rem (* t c) p)
                    R (rem (* R b) p)]
                (recur M c t R)
                )
              )
            )
          )
        )
      )
    )
  )

; Testing--using Python examples
(doseq [[n p]  [[10, 13], [56, 101], [1030, 10009], [44402, 100049],
                [665820697, 1000000009], [881398088036, 1000000000039],
                [41660815127637347468140745042827704103445750172002, 100000000000000000000000000000000000000000000000577]]
        :let [r (tonelli n p)]]
  (println (format "n: %5d p: %d \n\troots: %5d %5d" (biginteger n) (biginteger p) (biginteger r) (biginteger (- p r)))))


import std.stdio, std.traits;

const final class Node(T) {
    T data;
    Node left, right;

    this(in T data, in Node left=null, in Node right=null)
    const pure nothrow {
        this.data = data;
        this.left = left;
        this.right = right;
    }
}

// 'static' templated opCall can't be used in Node
auto node(T)(in T data, in Node!T left=null, in Node!T right=null)
pure nothrow {
    return new const(Node!T)(data, left, right);
}

void show(T)(in T x) {
    write(x, " ");
}

enum Visit { pre, inv, post }

// 'visitor' can be any kind of callable or it uses a default visitor.
// TNode can be any kind of Node, with data, left and right fields,
// so this is more generic than a member function of Node.
void backtrackingOrder(Visit v, TNode, TyF=void*)
                      (in TNode node, TyF visitor=null) {
    alias trueVisitor = Select!(is(TyF == void*), show, visitor);
    if (node !is null) {
        static if (v == Visit.pre)
            trueVisitor(node.data);
        backtrackingOrder!v(node.left, visitor);
        static if (v == Visit.inv)
            trueVisitor(node.data);
        backtrackingOrder!v(node.right, visitor);
        static if (v == Visit.post)
            trueVisitor(node.data);
    }
}

void levelOrder(TNode, TyF=void*)
               (in TNode node, TyF visitor=null, const(TNode)[] more=[]) {
    alias trueVisitor = Select!(is(TyF == void*), show, visitor);
    if (node !is null) {
        more ~= [node.left, node.right];
        trueVisitor(node.data);
    }
    if (more.length)
        levelOrder(more[0], visitor, more[1 .. $]);
}

void main() {
    alias N = node;
    const tree = N(1,
                      N(2,
                           N(4,
                                N(7)),
                           N(5)),
                      N(3,
                           N(6,
                                N(8),
                                N(9))));

    write("  preOrder: ");
    tree.backtrackingOrder!(Visit.pre);
    write("\n   inorder: ");
    tree.backtrackingOrder!(Visit.inv);
    write("\n postOrder: ");
    tree.backtrackingOrder!(Visit.post);
    write("\nlevelorder: ");
    tree.levelOrder;
    writeln;
}


import Data.List ((\\), elemIndex, intersect, nub)
import Data.Bifunctor (bimap, first)

combs 0 _ = [[]]
combs _ [] = []
combs k (x:xs) = ((x :) <$> combs (k - 1) xs) ++ combs k xs

depLibs :: [(String, String)]
depLibs =
  [ ( "des_system_lib"
    , "std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee")
  , ("dw01", "ieee dw01 dware gtech")
  , ("dw02", "ieee dw02 dware")
  , ("dw03", "std synopsys dware dw03 dw02 dw01 ieee gtech")
  , ("dw04", "dw04 ieee dw01 dware gtech")
  , ("dw05", "dw05 ieee dware")
  , ("dw06", "dw06 ieee dware")
  , ("dw07", "ieee dware")
  , ("dware", "ieee dware")
  , ("gtech", "ieee gtech")
  , ("ramlib", "std ieee")
  , ("std_cell_lib", "ieee std_cell_lib")
  , ("synopsys", [])
  ]

toposort :: [(String, String)] -> [String]
toposort xs
  | (not . null) cycleDetect =
    error $ "Dependency cycle detected for libs " ++ show cycleDetect
  | otherwise = foldl makePrecede [] dB
  where
    dB = (\(x, y) -> (x, y \\ x)) . bimap return words <$> xs
    makePrecede ts ([x], xs) =
      nub $
      case elemIndex x ts of
        Just i -> uncurry (++) $ first (++ xs) $ splitAt i ts
        _ -> ts ++ xs ++ [x]
    cycleDetect =
      filter ((> 1) . length) $
      (\[(a, as), (b, bs)] -> (a `intersect` bs) ++ (b `intersect` as)) <$>
      combs 2 dB

main :: IO ()
main = print $ toposort depLibs


import std.bigint;
import std.stdio;
import std.typecons;

alias Pair = Tuple!(long, "n", long, "p");

enum BIGZERO = BigInt("0");
enum BIGONE = BigInt("1");
enum BIGTWO = BigInt("2");
enum BIGTEN = BigInt("10");

struct Solution {
    BigInt root1, root2;
    bool exists;
}

/// https://en.wikipedia.org/wiki/Modular_exponentiation#Right-to-left_binary_method
BigInt modPow(BigInt b, BigInt e, BigInt n) {
    if (n == 1) return BIGZERO;
    BigInt result = 1;
    b = b % n;
    while (e > 0) {
        if (e % 2 == 1) {
            result = (result * b) % n;
        }
        e >>= 1;
        b = (b*b) % n;
    }
    return result;
}

Solution ts(long n, long p) {
    return ts(BigInt(n), BigInt(p));
}

Solution ts(BigInt n, BigInt p) {
    auto powMod(BigInt a, BigInt e) {
        return a.modPow(e, p);
    }

    auto ls(BigInt a) {
        return powMod(a, (p-1)/2);
    }

    if (ls(n) != 1) return Solution(BIGZERO, BIGZERO, false);
    auto q = p - 1;
    auto ss = BIGZERO;
    while ((q & 1) == 0) {
        ss = ss + 1;
        q = q >> 1;
    }

    if (ss == BIGONE) {
        auto r1 = powMod(n, (p + 1) / 4);
        return Solution(r1, p - r1, true);
    }

    auto z = BIGTWO;
    while (ls(z) != p - 1) z = z + 1;
    auto c = powMod(z, q);
    auto r = powMod(n, (q + 1) / 2);
    auto t = powMod(n, q);
    auto m = ss;

    while (true) {
        if (t == 1) return Solution(r, p - r, true);
        auto i = BIGZERO;
        auto zz = t;
        while (zz != 1 && i < m - 1) {
            zz  = zz * zz % p;
            i = i + 1;
        }
        auto b = c;
        auto e = m - i - 1;
        while (e > 0) {
            b = b * b % p;
            e = e - 1;
        }
        r = r * b % p;
        c = b * b % p;
        t = t * c % p;
        m = i;
    }
}

void main() {
    auto pairs = [
        Pair(             10L,                13L),
        Pair(             56L,               101L),
        Pair(          1_030L,            10_009L),
        Pair(          1_032L,            10_009L),
        Pair(         44_402L,           100_049L),
        Pair(    665_820_697L,     1_000_000_009L),
        Pair(881_398_088_036L, 1_000_000_000_039L),
    ];

    foreach (pair; pairs) {
        auto sol = ts(pair.n, pair.p);

        writeln("n = ", pair.n);
        writeln("p = ", pair.p);
        if (sol.exists) {
            writeln("root1 = ", sol.root1);
            writeln("root2 = ", sol.root2);
        }
        else writeln("No solution exists");
        writeln();
    }

    auto bn = BigInt("41660815127637347468140745042827704103445750172002");
    auto bp = BIGTEN ^^ 50 + 577L;
    auto sol = ts(bn, bp);
    writeln("n = ", bn);
    writeln("p = ", bp);
    if (sol.exists) {
        writeln("root1 = ", sol.root1);
        writeln("root2 = ", sol.root2);
    }
    else writeln("No solution exists");
}


def btree := [1, [2, [4, [7, null, null],
                         null],
                     [5, null, null]],
                 [3, [6, [8, null, null],
                         [9, null, null]],
                     null]]

def backtrackingOrder(node, pre, mid, post) {
    switch (node) {
        match ==null {}
        match [value, left, right] {
            pre(value)
            backtrackingOrder(left, pre, mid, post)
            mid(value)
            backtrackingOrder(right, pre, mid, post)
            post(value)
        }
    }
}

def levelOrder(root, func) {
    var level := [root].diverge()
    while (level.size() > 0) {
        for node in level.removeRun(0) {
            switch (node) {
                match ==null {}
                match [value, left, right] {
                    func(value)
                    level.push(left)
                    level.push(right)
}   }   }   }   }

print("preorder:   ")
backtrackingOrder(btree, fn v { print(" ", v) }, fn _ {}, fn _ {})
println()

print("inorder:    ")
backtrackingOrder(btree, fn _ {}, fn v { print(" ", v) }, fn _ {})
println()

print("postorder:  ")
backtrackingOrder(btree, fn _ {}, fn _ {}, fn v { print(" ", v) })
println()

print("level-order:")
levelOrder(btree, fn v { print(" ", v) })
println()


import Algorithms as algo;
import Text as text;

class DirectedGraph {
	_adjecentVertices = {};
	add_vertex( vertex_ ) {
		_adjecentVertices[vertex_] = [];
	}
	add_edge( from_, to_ ) {
		_adjecentVertices[from_].push( to_ );
	}
	adjecent_vertices( vertex_ ) {
		return ( vertex_ ∈ _adjecentVertices ? _adjecentVertices.get( vertex_ ) : [] );
	}
}

class DepthFirstSearch {
	_visited = set();
	_postOrder = [];
	_cycleDetector = set();
	run( graph_, start_ ) {
		_cycleDetector.insert( start_ );
		_visited.insert( start_ );
		for ( vertex : graph_.adjecent_vertices( start_ ) ) {
			if ( vertex == start_ ) {
				continue;
			}
			if ( vertex ∈ _cycleDetector ) {
				throw Exception( "A cycle involving vertices {} found!".format( _cycleDetector ) );
			}
			if ( vertex ∉ _visited ) {
				run( graph_, vertex );
			}
		}
		_postOrder.push( start_ );
		_cycleDetector.erase( start_ );
	}
	topological_sort( graph_ ) {
		for ( vertex : graph_._adjecentVertices ) {
			if ( vertex ∉ _visited ) {
				run( graph_, vertex );
			}
		}
		return ( _postOrder );
	}
}

main() {
	rawdata =
		"des_system_lib  | std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee\n"
		"dw01            | ieee dw01 dware gtech\n"
		"dw02            | ieee dw02 dware\n"
		"dw03            | std synopsys dware dw03 dw02 dw01 ieee gtech\n"
		"dw04            | dw04 ieee dw01 dware gtech\n"
		"dw05            | dw05 ieee dware\n"
		"dw06            | dw06 ieee dware\n"
		"dw07            | ieee dware\n"
		"dware           | ieee dware\n"
		"gtech           | ieee gtech\n"
		"ramlib          | std ieee\n"
		"std_cell_lib    | ieee std_cell_lib\n"
		"synopsys        |\n";
	dg = DirectedGraph();
	for ( l : algo.filter( text.split( rawdata, "\n" ), @( x ) { size( x ) > 0; } ) ) {
		def = algo.materialize( algo.map( text.split( l, "|" ), string.strip ), list );
		dg.add_vertex( def[0] );
		for ( n : algo.filter( algo.map( text.split( def[1], " " ), string.strip ), @( x ) { size( x ) > 0; } ) ) {
			dg.add_edge( def[0], n );
		}
	}
	dfs = DepthFirstSearch();
	print( "{}\n".format( dfs.topological_sort( dg ) ) );
}


record graph(nodes,arcs)
global ex_name, in_name

procedure main()
   show(tsort(getgraph()))
end

procedure tsort(g)
   t := ""
   while (n := g.nodes -- pnodes(g)) ~== "" do {
      t ||:= "("||n||")"
      g := delete(g,n)
      }
   if g.nodes == '' then return t
   write("graph contains the cycle:")
   write("\t",genpath(fn := !g.nodes,fn,g))
end

## pnodes(g) -- return the predecessor nodes of g
#     (those that have an arc from them)
procedure pnodes(g)
   static labels, fromnodes
   initial {
           labels := &ucase
           fromnodes := 'ACEGIKMOQSUWY'
           }
   return cset(select(g.arcs,labels, fromnodes))
end

## select(s,image,object) - efficient node selection
procedure select(s,image,object)
   slen := *s
   ilen := *image
   return if slen <= ilen then map(object[1+:slen/2],image[1+:slen],s)
          else map(object,image,s[1+:ilen]) || select(s[1+ilen:0],image,object)
end

## delete(g,x) -- deletes all nodes in x from graph g
#     note that arcs must be deleted as well
procedure delete(g,x)
   t := ""
   g.arcs ? while arc := move(2) do if not upto(x,arc) then t ||:= arc
   return graph(g.nodes--x,t)
end

## getgraph() -- read and construct a graph
#      graph is described via sets of arcs, as in:
#
#           from to1 to2 to3
#
# external names are converted to single character names for efficiency
# self-referential arcs are ignored
procedure getgraph()
   static labels
   initial labels := &cset
   ex_name := table()
   in_name := table()
   count := 0
   arcstr := ""
   nodes := ''
   every line := !&input do {
       nextWord := create genWords(line)
       if nfrom := @nextWord then {
           /in_name[nfrom] := &cset[count +:= 1]
           /ex_name[in_name[nfrom]] := nfrom
           nodes ++:= in_name[nfrom]
           while nto := @nextWord do {
               if nfrom ~== nto then {
                   /in_name[nto] := &cset[count +:= 1]
                   /ex_name[in_name[nto]] := nto
                   nodes ++:= in_name[nto]
                   arcstr ||:= in_name[nfrom] || in_name[nto]
                   }
               }
           }
       }
   return graph(nodes,arcstr)
end

# generate all 'words' in string
procedure genWords(s)
    static wchars
    initial wchars := &cset -- ' \t'
    s ?  while tab(upto(wchars))\1 do suspend tab(many(wchars))\1
end

## show(t) - return the external names (in order) for the nodes in t
#  Each output line contains names that are independent of each other
procedure show(t)
   line := ""
   every n := !t do
      case n of {
         "(" : line ||:= "\n\t("
         ")" : line[-1] := ")"
         default : line ||:= ex_name[n] || " "
      }
   write(line)
end

## genpath(f,t,g) -- generate paths from f to t in g
procedure genpath(f,t,g, seen)
   /seen := ''
   seen ++:= f
   sn := nnodes(f,g)
   if t ** sn == t then return ex_name[f] || " -> " || ex_name[t]
   suspend ex_name[f] || " -> " || genpath(!(sn --seen),t,g,seen)
end

## nnodes(f,g) -- compute all nodes that could follow f in g
procedure nnodes(f,g)
   t := ''
   g.arcs ? while arc := move(2) do if arc[1] == f then t ++:= arc[2]
   return t
end


(require 'bigint)
;; test equality mod p
(define-syntax-rule (mod= a b p)
	 (zero?  (% (- a b) p)))
;; assign mod p
(define-syntax-rule (mod:≡ s v p)
	(set! s (% v p)))

(define (Legendre a p)
	 (powmod a (/ (1- p) 2) p))

(define (Tonelli n p)
    (unless (= 1 (Legendre n p)) (error "not a square (mod p)" (list n p)))
    (define q (1- p))
    (define s 0)
	(while (even? q)
		(/= q 2)
		(++ s))
	(if (= s 1) (powmod n (/ (1+ p) 4) p)
	(begin
	(define z
		(for ((z (in-range 2 p)))
		  #:break (= (1- p)  (Legendre z p)) => z ))

	(define c (powmod z q p))
	(define r (powmod n (/ (1+ q) 2) p))
	(define t (powmod n q p))
	(define m s)
	(define t2 0)
	(while #t
		#:break (mod= 1  t p) => r
		(mod:≡ t2 (* t t) p)
		(define i
			(for ((i (in-range 1 m)))
				#:break (mod= t2 1 p) => i
				(mod:≡ t2 (* t2 t2) p)))
		(define b (powmod c (expt 2 (- m i 1)) p))
		(mod:≡ r (* r b) p)
		(mod:≡ c (* b b) p)
		(mod:≡ t (* t c) p)
		(set! m i)))))


note
	description : "Application for tree traversal demonstration"
        output      : "[
    	                Prints preorder, inorder, postorder and levelorder traversal of an example binary tree.
    		      ]"
	author	    : "Jascha Grübel"
	date        : "$2014-01-07$"
	revision    : "$1.0$"

class
	APPLICATION

create
	make

feature {NONE} -- Initialization

	make
			-- Run Tree traversal example.
		local
			tree:NODE
		do
			create tree.make (1)
			tree.set_left_child (create {NODE}.make (2))
			tree.set_right_child (create {NODE}.make (3))
			tree.left_child.set_left_child (create {NODE}.make (4))
			tree.left_child.set_right_child (create {NODE}.make (5))
			tree.left_child.left_child.set_left_child (create {NODE}.make (7))
			tree.right_child.set_left_child (create {NODE}.make (6))
			tree.right_child.left_child.set_left_child (create {NODE}.make (8))
			tree.right_child.left_child.set_right_child (create {NODE}.make (9))

			Io.put_string ("preorder:   ")
			tree.print_preorder
			Io.put_new_line

			Io.put_string ("inorder:    ")
			tree.print_inorder
			Io.put_new_line

			Io.put_string ("postorder:  ")
			tree.print_postorder
			Io.put_new_line

			Io.put_string ("level-order:")
			tree.print_levelorder
			Io.put_new_line

		end

end -- class APPLICATION


dependencySort=: monad define
  parsed=. <@;:;._2 y
  names=. {.&>parsed
  depends=. (> [email protected]@#) names e.S:1 parsed
  depends=. (+. +./ .*.~)^:_ depends
  assert.-.1 e. (<0 1)|:depends
  (-.&names ~.;parsed),names /: +/"1 depends
)


import java.util.*;

public class TopologicalSort {

    public static void main(String[] args) {
        String s = "std, ieee, des_system_lib, dw01, dw02, dw03, dw04, dw05,"
                + "dw06, dw07, dware, gtech, ramlib, std_cell_lib, synopsys";

        Graph g = new Graph(s, new int[][]{
            {2, 0}, {2, 14}, {2, 13}, {2, 4}, {2, 3}, {2, 12}, {2, 1},
            {3, 1}, {3, 10}, {3, 11},
            {4, 1}, {4, 10},
            {5, 0}, {5, 14}, {5, 10}, {5, 4}, {5, 3}, {5, 1}, {5, 11},
            {6, 1}, {6, 3}, {6, 10}, {6, 11},
            {7, 1}, {7, 10},
            {8, 1}, {8, 10},
            {9, 1}, {9, 10},
            {10, 1},
            {11, 1},
            {12, 0}, {12, 1},
            {13, 1}
        });

        System.out.println("Topologically sorted order: ");
        System.out.println(g.topoSort());
    }
}

class Graph {
    String[] vertices;
    boolean[][] adjacency;
    int numVertices;

    public Graph(String s, int[][] edges) {
        vertices = s.split(",");
        numVertices = vertices.length;
        adjacency = new boolean[numVertices][numVertices];

        for (int[] edge : edges)
            adjacency[edge[0]][edge[1]] = true;
    }

    List<String> topoSort() {
        List<String> result = new ArrayList<>();
        List<Integer> todo = new LinkedList<>();

        for (int i = 0; i < numVertices; i++)
            todo.add(i);

        try {
            outer:
            while (!todo.isEmpty()) {
                for (Integer r : todo) {
                    if (!hasDependency(r, todo)) {
                        todo.remove(r);
                        result.add(vertices[r]);
                         // no need to worry about concurrent modification
                        continue outer;
                    }
                }
                throw new Exception("Graph has cycles");
            }
        } catch (Exception e) {
            System.out.println(e);
            return null;
        }
        return result;
    }

    boolean hasDependency(Integer r, List<Integer> todo) {
        for (Integer c : todo) {
            if (adjacency[r][c])
                return true;
        }
        return false;
    }
}


' version 11-04-2017
' compile with: fbc -s console
' maximum for p is 17 digits to be on the save side

' TRUE/FALSE are built-in constants since FreeBASIC 1.04
' But we have to define them for older versions.
#Ifndef TRUE
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

Function mul_mod(a As ULongInt, b As ULongInt, modulus As ULongInt) As ULongInt
    ' returns a * b mod modulus
    Dim As ULongInt x, y = a Mod modulus

    While b > 0
        If (b And 1) = 1 Then
            x = (x + y) Mod modulus
        End If
        y = (y Shl 1) Mod modulus
        b = b Shr 1
    Wend

    Return x

End Function

Function pow_mod(b As ULongInt, power As ULongInt, modulus As ULongInt) As ULongInt
    ' returns b ^ power mod modulus
    Dim As ULongInt x = 1

    While power > 0
        If (power And 1) = 1 Then
            ' x = (x * b) Mod modulus
            x = mul_mod(x, b, modulus)
        End If
        ' b = (b * b) Mod modulus
        b = mul_mod(b, b, modulus)
        power = power Shr 1
    Wend

    Return x

End Function

Function Isprime(n As ULongInt, k As Long) As Long
    ' miller-rabin prime test
    If n > 9223372036854775808ull Then ' limit 2^63, pow_mod/mul_mod can't handle bigger numbers
        Print "number is to big, program will end"
        Sleep
        End
    End If

    ' 2 is a prime, if n is smaller then 2 or n is even then n = composite
    If n = 2 Then Return TRUE
    If (n < 2) OrElse ((n And 1) = 0) Then Return FALSE

    Dim As ULongInt a, x, n_one = n - 1, d = n_one
    Dim As UInteger s

    While (d And 1) = 0
        d = d Shr 1
        s = s + 1
    Wend

    While k > 0
        k = k - 1
        a = Int(Rnd * (n -2)) +2          ' 2 <= a < n
        x = pow_mod(a, d, n)
        If (x = 1) Or (x = n_one) Then Continue While
        For r As Integer = 1 To s -1
            x = pow_mod(x, 2, n)
            If x = 1 Then Return FALSE
            If x = n_one Then Continue While
        Next
        If x <> n_one Then Return FALSE
    Wend
    Return TRUE

End Function

Function legendre_symbol (a As LongInt, p As LongInt) As LongInt

    Dim As LongInt x = pow_mod(a, ((p -1) \ 2), p)
    If p -1 = x Then
        Return x - p
    Else
        Return x
    End If

End Function

' ------=< MAIN >=------

Dim As LongInt b, c, i, k, m, n, p, q, r, s, t, z

For k = 1 To 7
    Read n, p
    Print "Find solution for n ="; n; " and p =";p

    If legendre_symbol(n, p) <> 1 Then
        Print n;" is not a quadratic residue"
        Print
        Continue For
    End If

    If p = 2 OrElse Isprime(p, 15) = FALSE Then
        Print p;" is not a odd prime"
        Print
        Continue For
    End If

    s = 0 : q = p -1
    Do
        s += 1
        q \= 2
    Loop Until (q And 1) = 1

    If s = 1 And (p Mod 4) = 3 Then
        r = pow_mod(n, ((p +1) \ 4), p)
        Print "Solution found:"; r; " and"; p - r
        Print
        Continue For
    End If

    z = 1
    Do
        z += 1
    Loop Until legendre_symbol(z, p) = -1
    c = pow_mod(z, q, p)
    r = pow_mod(n, (q +1) \ 2, p)
    t = pow_mod(n, q, p)
    m = s

    Do
        i = 0
        If (t Mod p) = 1 Then
            Print "Solution found:"; r; " and"; p - r
            Print
            Continue For
        End If

        Do
            i += 1
            If i >= m Then Continue For
        Loop Until pow_mod(t, 2 ^ i, p) = 1
        b = pow_mod(c, (2 ^ (m - i -1)), p)
        r = mul_mod(r, b, p)
        c = mul_mod(b, b, p)
        t = mul_mod(t, c, p)' t = t * b ^ 2
        m = i
    Loop

Next

Data 10, 13, 56, 101, 1030, 10009, 1032, 10009, 44402, 100049
Data 665820697, 1000000009, 881398088036, 1000000000039

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


import extensions;
import extensions'routines;
import system'collections;

singleton DummyNode
{
    get generic()
        = EmptyEnumerable;
}

class Node
{
    rprop int  Value;
    rprop Node Left;
    rprop Node Right;

    constructor new(int value)
    {
        Value := value
    }

    constructor new(int value, Node left)
    {
        Value := value;
        Left := left;
    }

    constructor new(int value, Node left, Node right)
    {
        Value := value;
        Left := left;
        Right := right
    }

    Preorder = new Enumerable
    {
        Enumerator enumerator() = CompoundEnumerator.new(
                                        SingleEnumerable.new(Value),
                                        (Left ?? DummyNode).Preorder,
                                        (Right ?? DummyNode).Preorder);
    };

    Inorder = new Enumerable
    {
        Enumerator enumerator()
        {
            if (nil != Left)
            {
                ^ CompoundEnumerator.new(Left.Inorder, SingleEnumerable.new(Value), (Right ?? DummyNode).Inorder)
            }
            else
            {
                ^ SingleEnumerable.new(Value).enumerator()
            }
        }
    };

    Postorder = new Enumerable
    {
        Enumerator enumerator()
        {
            if (nil == Left)
            {
                ^ SingleEnumerable.new(Value).enumerator()
            }
            else if (nil == Right)
            {
                ^ CompoundEnumerator.new(Left.Postorder, SingleEnumerable.new(Value))
            }
            else
            {
                ^ CompoundEnumerator.new(Left.Postorder, Right.Postorder, SingleEnumerable.new(Value))
            }
        }
    };

    LevelOrder = new Enumerable
    {
        Queue<Node> queue := class Queue<Node>.allocate(4).push:self;

        Enumerator enumerator() = new Enumerator
        {
            bool next() = queue.isNotEmpty();

            get()
            {
                Node item := queue.pop();
                Node left := item.Left;
                Node right := item.Right;

                if (nil != left)
                {
                    queue.push(left)
                };
                if (nil != right)
                {
                    queue.push(right)
                };

                ^ item.Value
            }

            reset()
            {
                NotSupportedException.raise()
            }

            enumerable() = queue;
        };
    };
}

public program()
{
   var tree := Node.new(1, Node.new(2, Node.new(4, Node.new(7)), Node.new(5)), Node.new(3, Node.new(6, Node.new(8), Node.new(9))));

   console.printLine("Preorder  :", tree.Preorder);
   console.printLine("Inorder   :", tree.Inorder);
   console.printLine("Postorder :", tree.Postorder);
   console.printLine("LevelOrder:", tree.LevelOrder)
}


const libs =
  `des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee
  dw01             ieee dw01 dware gtech
  dw02             ieee dw02 dware
  dw03             std synopsys dware dw03 dw02 dw01 ieee gtech
  dw04             dw04 ieee dw01 dware gtech
  dw05             dw05 ieee dware
  dw06             dw06 ieee dware
  dw07             ieee dware
  dware            ieee dware
  gtech            ieee gtech
  ramlib           std ieee
  std_cell_lib     ieee std_cell_lib
  synopsys`;

// A map of the input data, with the keys as the packages, and the values as
// and array of packages on which it depends.
const D = libs
  .split('\n')
  .map(e => e.split(' ').filter(e => e != ''))
  .reduce((p, c) =>
    p.set(c[0], c.filter((e, i) => i > 0 && e !== c[0] ? e : null)), new Map());
[].concat(...D.values()).forEach(e => {
  D.set(e, D.get(e) || [])
});

// The above map rotated so that it represents a DAG of the form
// Map {
//    A => [ A, B, C],
//    B => [C],
//    C => []
// }
// where each key represents a node, and the array contains the edges.
const G = [...D.keys()].reduce((p, c) =>
  p.set(
    c,
    [...D.keys()].filter(e => D.get(e).includes(c))),
  new Map()
);

// An array of leaf nodes; nodes with 0 in degrees.
const Q = [...D.keys()].filter(e => D.get(e).length == 0);

// The result array.
const S = [];
while (Q.length) {
  const u = Q.pop();
  S.push(u);
  G.get(u).forEach(v => {
    D.set(v, D.get(v).filter(e => e !== u));
    if (D.get(v).length == 0) {
      Q.push(v);
    }
  });
}

console.log('Solution:', S);


package main

import "fmt"

// Arguments n, p as described in WP
// If Legendre symbol != 1, ok return is false.  Otherwise ok return is true,
// R1 is WP return value R and for convenience R2 is p-R1.
func ts(n, p int) (R1, R2 int, ok bool) {
    // a^e mod p
    powModP := func(a, e int) int {
        s := 1
        for ; e > 0; e-- {
            s = s * a % p
        }
        return s
    }
    // Legendre symbol, returns 1, 0, or -1 mod p -- that's 1, 0, or p-1.
    ls := func(a int) int {
        return powModP(a, (p-1)/2)
    }
    // argument validation
    if ls(n) != 1 {
        return 0, 0, false
    }
    // WP step 1, factor out powers two.
    // variables Q, S named as at WP.
    Q := p - 1
    S := 0
    for Q&1 == 0 {
        S++
        Q >>= 1
    }
    // WP step 1, direct solution
    if S == 1 {
        R1 = powModP(n, (p+1)/4)
        return R1, p - R1, true
    }
    // WP step 2, select z, assign c
    z := 2
    for ; ls(z) != p-1; z++ {
    }
    c := powModP(z, Q)
    // WP step 3, assign R, t, M
    R := powModP(n, (Q+1)/2)
    t := powModP(n, Q)
    M := S
    // WP step 4, loop
    for {
        // WP step 4.1, termination condition
        if t == 1 {
            return R, p - R, true
        }
        // WP step 4.2, find lowest i...
        i := 0
        for z := t; z != 1 && i < M-1; {
            z = z * z % p
            i++
        }
        // WP step 4.3, using a variable b, assign new values of R, t, c, M
        b := c
        for e := M - i - 1; e > 0; e-- {
            b = b * b % p
        }
        R = R * b % p
        c = b * b % p // more convenient to compute c before t
        t = t * c % p
        M = i
    }
}

func main() {
    fmt.Println(ts(10, 13))
    fmt.Println(ts(56, 101))
    fmt.Println(ts(1030, 10009))
    fmt.Println(ts(1032, 10009))
    fmt.Println(ts(44402, 100049))
}


component BinaryTreeTraversals (Tree, Element);
type Tree;
type Node = Tree;
     Tree (LeftTree = Tree, Element, RightTree = Tree) -> Tree;
     Leaf (Element)                                    -> Node;
     Node (Tree)                                       -> Node;
     Item (Node)                                       -> Element;

     Preorder (Tree)                                   -> multi (Node);
     Inorder (Tree)                                    -> multi (Node);
     Postorder (Tree)                                  -> multi (Node);
     Level_order(Tree) 		                       -> multi (Node);
begin
     Tree (Lefttree, Item, Righttree) = Tree: [ Lefttree; Item; Righttree ];
     Leaf (anItem) = Tree (null(Tree), anItem, null(Tree) );
     Node (aTree) = aTree;
     Item (aNode) = aNode.Item;

     Preorder (=null(Tree)) = no(Tree);
     Preorder (T) = ( T, Preorder (T.Lefttree), Preorder (T.Righttree));

     Inorder (=null(Tree)) = no(Tree);
     Inorder (T) = ( Inorder (T.Lefttree), T, Inorder (T.Righttree));

     Postorder (=null(Tree)) = no(Tree);
     Postorder (T) = ( Postorder (T.Lefttree), Postorder (T.Righttree), T);

     Level_order(T) = [ Queue = {T};
			 node = Tree:items(Queue);
			   [ result(node);
			     add(Queue, node.Lefttree) when valid(node.Lefttree);
 			     add(Queue, node.Righttree) when valid(node.Righttree);
			   ];
			 no(Tree);
		       ];
end component BinaryTreeTraversals;


# independent/0 emits an array of the dependencies that have no dependencies
# Input: an object representing a normalized dependency graph
def independent:
  . as $G
  | reduce keys[] as $key
      ([];
       . +  ((reduce $G[$key][] as $node
               ([];
                if ($G[$node] == null or ($G[$node]|length)==0) then . + [$node]
                else .
                end ))))
  | unique;

# normalize/0 eliminates self-dependencies in the input dependency graph.
# Input: an object representing a dependency graph.
def normalize:
  . as $G
  | reduce keys[] as $key
      ($G;
       .[$key] as $nodes
       | if $nodes and ($nodes|index($key)) then .[$key] = $nodes - [$key] else . end);

# minus/1 removes all the items in ary from each of the values in the input object
# Input: an object representing a dependency graph
def minus(ary):
  . as $G | with_entries(.value -= ary);

# tsort/0 emits the topologically sorted nodes of the input,
# in ">" order.
# Input is assumed to be an object representing a dependency
# graph and need not be normalized.
def tsort:
  # _sort: input: [L, Graph], where L is the tsort so far
  def _tsort:

    def done: [.[]] | all( length==0 );

    .[0] as $L | .[1] as $G
    | if ($G|done) then $L + (($G|keys) - $L)
      else
         ($G|independent) as $I
         | if (($I|length) == 0)
           then error("the dependency graph is cyclic: \($G)")
           else [ ($L + $I), ($G|minus($I))] | _tsort
           end
      end;

  normalize | [[], .] | _tsort ;

tsort


function toposort(data::Dict{T,Set{T}}) where T
    data = copy(data)
    for (k, v) in data
        delete!(v, k)
    end
    extraitems = setdiff(reduce(∪, values(data)), keys(data))
    for item in extraitems
        data[item] = Set{T}()
    end
    rst = Vector{T}()
    while true
        ordered = Set(item for (item, dep) in data if isempty(dep))
        if isempty(ordered) break end
        append!(rst, ordered)
        data = Dict{T,Set{T}}(item => setdiff(dep, ordered) for (item, dep) in data if item ∉ ordered)
    end
    @assert isempty(data) "a cyclic dependency exists amongst $(keys(data))"
    return rst
end

data = Dict{String,Set{String}}(
    "des_system_lib" => Set(split("std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee")),
    "dw01" =>           Set(split("ieee dw01 dware gtech")),
    "dw02" =>           Set(split("ieee dw02 dware")),
    "dw03" =>           Set(split("std synopsys dware dw03 dw02 dw01 ieee gtech")),
    "dw04" =>           Set(split("dw04 ieee dw01 dware gtech")),
    "dw05" =>           Set(split("dw05 ieee dware")),
    "dw06" =>           Set(split("dw06 ieee dware")),
    "dw07" =>           Set(split("ieee dware")),
    "dware" =>          Set(split("ieee dware")),
    "gtech" =>          Set(split("ieee gtech")),
    "ramlib" =>         Set(split("std ieee")),
    "std_cell_lib" =>   Set(split("ieee std_cell_lib")),
    "synopsys" =>       Set(),
    )

println("# Topologically sorted:\n - ", join(toposort(data), "\n - "))


import Data.List (genericTake, genericLength)
import Data.Bits (shiftR)

powMod :: Integer -> Integer -> Integer -> Integer
powMod m b e = go b e 1
  where
    go b e r
      | e == 0 = r
      | odd e  = go ((b*b) `mod` m) (e `div` 2) ((r*b) `mod` m)
      | even e = go ((b*b) `mod` m) (e `div` 2) r

legendre :: Integer -> Integer -> Integer
legendre a p = powMod p a ((p - 1) `div` 2)

tonelli :: Integer -> Integer -> Maybe (Integer, Integer)
tonelli n p | legendre n p /= 1 = Nothing
tonelli n p =
  let s = length $ takeWhile even $ iterate (`div` 2) (p-1)
      q = shiftR (p-1) s
  in if s == 1
    then let r = powMod p n ((p+1) `div` 4)
         in Just (r, p - r)
    else let z = (2 +) . genericLength
               $ takeWhile (\i -> p - 1 /= legendre i p)
               $ [2..p-1]
         in loop s
            ( powMod p z q )
            ( powMod p n $ (q+1) `div` 2 )
            ( powMod p n q )
  where
    loop m c r t
      | (t - 1) `mod` p == 0 = Just (r, p - r)
      | otherwise =
        let i = (1 +) . genericLength . genericTake (m - 2)
              $ takeWhile (\t2 -> (t2 - 1) `mod` p /= 0)
              $ iterate (\t2 -> (t2*t2) `mod` p)
              $ (t*t) `mod` p
            b = powMod p c (2^(m - i - 1))
            r' = (r*b)  `mod` p
            c' = (b*b)  `mod` p
            t' = (t*c') `mod` p
        in loop i c' r' t'


defmodule Tree_Traversal do
  defp tnode, do: {}
  defp tnode(v), do: {:node, v, {}, {}}
  defp tnode(v,l,r), do: {:node, v, l, r}

  defp preorder(_,{}), do: :ok
  defp preorder(f,{:node,v,l,r}) do
    f.(v)
    preorder(f,l)
    preorder(f,r)
  end

  defp inorder(_,{}), do: :ok
  defp inorder(f,{:node,v,l,r}) do
    inorder(f,l)
    f.(v)
    inorder(f,r)
  end

  defp postorder(_,{}), do: :ok
  defp postorder(f,{:node,v,l,r}) do
    postorder(f,l)
    postorder(f,r)
    f.(v)
  end

  defp levelorder(_, []), do: []
  defp levelorder(f, [{}|t]), do: levelorder(f, t)
  defp levelorder(f, [{:node,v,l,r}|t]) do
    f.(v)
    levelorder(f, t++[l,r])
  end
  defp levelorder(f, x), do: levelorder(f, [x])

  def main do
    tree = tnode(1,
                 tnode(2,
                       tnode(4, tnode(7), tnode()),
                       tnode(5, tnode(), tnode())),
                 tnode(3,
                       tnode(6, tnode(8), tnode(9)),
                       tnode()))
    f = fn x -> IO.write "#{x} " end
    IO.write "preorder:   "
    preorder(f, tree)
    IO.write "\ninorder:    "
    inorder(f, tree)
    IO.write "\npostorder:  "
    postorder(f, tree)
    IO.write "\nlevelorder: "
    levelorder(f, tree)
    IO.puts ""
  end
end

Tree_Traversal.main


// version 1.1.51

val s = "std, ieee, des_system_lib, dw01, dw02, dw03, dw04, dw05, " +
        "dw06, dw07, dware, gtech, ramlib, std_cell_lib, synopsys"

val deps = mutableListOf(
     2 to 0, 2 to 14, 2 to 13, 2 to 4, 2 to 3, 2 to 12, 2 to 1,
     3 to 1, 3 to 10, 3 to 11,
     4 to 1, 4 to 10,
     5 to 0, 5 to 14, 5 to 10, 5 to 4, 5 to 3, 5 to 1, 5 to 11,
     6 to 1, 6 to 3, 6 to 10, 6 to 11,
     7 to 1, 7 to 10,
     8 to 1, 8 to 10,
     9 to 1, 9 to 10,
     10 to 1,
     11 to 1,
     12 to 0, 12 to 1,
     13 to 1
)

class Graph(s: String, edges: List<Pair<Int,Int>>) {

    val vertices = s.split(", ")
    val numVertices = vertices.size
    val adjacency = List(numVertices) { BooleanArray(numVertices) }

    init {
        for (edge in edges) adjacency[edge.first][edge.second] = true
    }

    fun hasDependency(r: Int, todo: List<Int>): Boolean {
        return todo.any { adjacency[r][it] }
    }

    fun topoSort(): List<String>? {
        val result = mutableListOf<String>()
        val todo = MutableList<Int>(numVertices) { it }
        try {
            outer@ while(!todo.isEmpty()) {
                for ((i, r) in todo.withIndex()) {
                    if (!hasDependency(r, todo)) {
                        todo.removeAt(i)
                        result.add(vertices[r])
                        continue@outer
                     }
                }
                throw Exception("Graph has cycles")
            }
        }
        catch (e: Exception) {
            println(e)
            return null
        }
        return result
    }
}

fun main(args: Array<String>) {
    val g = Graph(s, deps)
    println("Topologically sorted order:")
    println(g.topoSort())
    println()
    // now insert 3 to 6 at index 10 of deps
    deps.add(10, 3 to 6)
    val g2 = Graph(s, deps)
    println("Following the addition of dw04 to the dependencies of dw01:")
    println(g2.topoSort())
}


leg=: dyad define
  x (y&|)@^ (y-1)%2
)

tosh=:dyad define
  assert. 1=1 p: y [ 'y must be prime'
  assert. 1=x leg y [ 'x must be square mod y'
  pow=. y&|@^
  if. 1=m=. {.1 q: y-1 do.
    r=. x pow (y+1)%4
  else.
    z=. 1x while. 1>: z leg y do. z=.z+1 end.
    c=. z pow q=. (y-1)%2^m
    r=. x pow (q+1)%2
    t=. x pow q
    while. t~:1 do.
      n=. t
      i=. 0
      whilst. 1~:n do.
        n=. n pow 2
        i=. i+1
      end.
      r=. y|r*b=. c pow 2^m-i+1
      m=. i
      t=. y|t*c=. b pow 2
    end.
  end.
  y|(,-)r
)


import java.math.BigInteger;
import java.util.List;
import java.util.Map;
import java.util.function.BiFunction;
import java.util.function.Function;

public class TonelliShanks {
    private static final BigInteger ZERO = BigInteger.ZERO;
    private static final BigInteger ONE = BigInteger.ONE;
    private static final BigInteger TEN = BigInteger.TEN;
    private static final BigInteger TWO = BigInteger.valueOf(2);
    private static final BigInteger FOUR = BigInteger.valueOf(4);

    private static class Solution {
        private BigInteger root1;
        private BigInteger root2;
        private boolean exists;

        Solution(BigInteger root1, BigInteger root2, boolean exists) {
            this.root1 = root1;
            this.root2 = root2;
            this.exists = exists;
        }
    }

    private static Solution ts(Long n, Long p) {
        return ts(BigInteger.valueOf(n), BigInteger.valueOf(p));
    }

    private static Solution ts(BigInteger n, BigInteger p) {
        BiFunction<BigInteger, BigInteger, BigInteger> powModP = (BigInteger a, BigInteger e) -> a.modPow(e, p);
        Function<BigInteger, BigInteger> ls = (BigInteger a) -> powModP.apply(a, p.subtract(ONE).divide(TWO));

        if (!ls.apply(n).equals(ONE)) return new Solution(ZERO, ZERO, false);

        BigInteger q = p.subtract(ONE);
        BigInteger ss = ZERO;
        while (q.and(ONE).equals(ZERO)) {
            ss = ss.add(ONE);
            q = q.shiftRight(1);
        }

        if (ss.equals(ONE)) {
            BigInteger r1 = powModP.apply(n, p.add(ONE).divide(FOUR));
            return new Solution(r1, p.subtract(r1), true);
        }

        BigInteger z = TWO;
        while (!ls.apply(z).equals(p.subtract(ONE))) z = z.add(ONE);
        BigInteger c = powModP.apply(z, q);
        BigInteger r = powModP.apply(n, q.add(ONE).divide(TWO));
        BigInteger t = powModP.apply(n, q);
        BigInteger m = ss;

        while (true) {
            if (t.equals(ONE)) return new Solution(r, p.subtract(r), true);
            BigInteger i = ZERO;
            BigInteger zz = t;
            while (!zz.equals(BigInteger.ONE) && i.compareTo(m.subtract(ONE)) < 0) {
                zz = zz.multiply(zz).mod(p);
                i = i.add(ONE);
            }
            BigInteger b = c;
            BigInteger e = m.subtract(i).subtract(ONE);
            while (e.compareTo(ZERO) > 0) {
                b = b.multiply(b).mod(p);
                e = e.subtract(ONE);
            }
            r = r.multiply(b).mod(p);
            c = b.multiply(b).mod(p);
            t = t.multiply(c).mod(p);
            m = i;
        }
    }

    public static void main(String[] args) {
        List<Map.Entry<Long, Long>> pairs = List.of(
            Map.entry(10L, 13L),
            Map.entry(56L, 101L),
            Map.entry(1030L, 10009L),
            Map.entry(1032L, 10009L),
            Map.entry(44402L, 100049L),
            Map.entry(665820697L, 1000000009L),
            Map.entry(881398088036L, 1000000000039L)
        );

        for (Map.Entry<Long, Long> pair : pairs) {
            Solution sol = ts(pair.getKey(), pair.getValue());
            System.out.printf("n = %s\n", pair.getKey());
            System.out.printf("p = %s\n", pair.getValue());
            if (sol.exists) {
                System.out.printf("root1 = %s\n", sol.root1);
                System.out.printf("root2 = %s\n", sol.root2);
            } else {
                System.out.println("No solution exists");
            }
            System.out.println();
        }

        BigInteger bn = new BigInteger("41660815127637347468140745042827704103445750172002");
        BigInteger bp = TEN.pow(50).add(BigInteger.valueOf(577));
        Solution sol = ts(bn, bp);
        System.out.printf("n = %s\n", bn);
        System.out.printf("p = %s\n", bp);
        if (sol.exists) {
            System.out.printf("root1 = %s\n", sol.root1);
            System.out.printf("root2 = %s\n", sol.root2);
        } else {
            System.out.println("No solution exists");
        }
    }
}


-module(tree_traversal).
-export([main/0]).
-export([preorder/2, inorder/2, postorder/2, levelorder/2]).
-export([tnode/0, tnode/1, tnode/3]).

-define(NEWLINE, io:format("~n")).

tnode() -> {}.
tnode(V) -> {node, V, {}, {}}.
tnode(V,L,R) -> {node, V, L, R}.

preorder(_,{}) -> ok;
preorder(F,{node,V,L,R}) ->
    F(V), preorder(F,L), preorder(F,R).

inorder(_,{}) -> ok;
inorder(F,{node,V,L,R}) ->
    inorder(F,L), F(V), inorder(F,R).

postorder(_,{}) -> ok;
postorder(F,{node,V,L,R}) ->
    postorder(F,L), postorder(F,R), F(V).

levelorder(_, []) -> [];
levelorder(F, [{}|T]) -> levelorder(F, T);
levelorder(F, [{node,V,L,R}|T]) ->
    F(V), levelorder(F, T++[L,R]);
levelorder(F, X) -> levelorder(F, [X]).

main() ->
    Tree = tnode(1,
                 tnode(2,
                       tnode(4, tnode(7), tnode()),
                       tnode(5, tnode(), tnode())),
                 tnode(3,
                       tnode(6, tnode(8), tnode(9)),
                       tnode())),
    F = fun(X) -> io:format("~p ",[X]) end,
    preorder(F, Tree), ?NEWLINE,
    inorder(F, Tree), ?NEWLINE,
    postorder(F, Tree), ?NEWLINE,
    levelorder(F, Tree), ?NEWLINE.


Module testthis {
	\\ empty stack
	Flush
	inventory LL
	append LL, "des_system_lib":=(List:="std", "synopsys", "std_cell_lib", "des_system_lib", "dw02", "dw01",  "ramlib", "ieee")
REM	append LL, "dw01":=(List:="dw04","ieee", "dw01", "dware", "gtech")
	append LL, "dw01":=(List:="ieee", "dw01", "dware", "gtech")
	append LL, "dw02":=(List:="ieee", "dw02", "dware")
	append LL, "dw03":=(List:="std", "synopsys", "dware", "dw03", "dw02", "dw01", "ieee", "gtech")
	append LL, "dw04":=(List:= "ieee", "dw01", "dware", "gtech")
	append LL, "dw05":=(List:="dw05", "ieee", "dware")
	append LL, "dw06":=(List:="dw06", "ieee", "dware")
	append LL, "dw07":=(List:="ieee", "dware")
	append LL, "dware":=(List:="ieee", "dware")
	append LL, "gtech":=(List:="ieee", "gtech")
	append LL, "ramlib":=(List:="std", "ieee")
	append LL, "std_cell_lib":=(List:="ieee", "std_cell_lib")
	append LL, "synopsys":=List
	\\ inventory itmes may have keys/items or keys.
	\\ here we have keys so keys return as item also
	\\ when we place an item in a key (an empty string) ...
	\\ we mark the item to not return the key but an empty string
	inventory final
	mm=each(LL)
	while mm
		k$=eval$(mm!)
		m=eval(mm)
		mmm=each(m)
		While mmm
			k1$=eval$(mmm!)
			if not exist(LL, k1$) then
				if not exist(final, k1$) then append final, k1$
				return m, k1$:=""      \\ mark that item
			else
				mmmm=Eval(LL)
				if len(mmmm)=0 then
					if not exist(final, k1$) then append final, k1$
					return m, k1$:=""     \\ mark that item
				end if
			end if
		end while
	end while
	mm=each(LL)
	while mm
		\\ using eval$(mm!) we read the key as string
		k$=eval$(mm!)
		if exist(final, k$) then continue
		m=eval(mm)
		mmm=each(m)
		While mmm
			\\ we read the item, if no item exist we get the key
			k1$=eval$(mmm)
			if k1$="" then continue
			if exist(final, k1$) then  continue
			data k1$    \\ push to end to stack
		end while
		while not empty
			read k1$
			if exist(final, k1$) then continue
			m=LL(k1$)
			mmm=each(m)
			delthis=0
			While mmm
				k2$=eval$(mmm)
				if k2$="" then continue
				if k1$=k2$ then continue
				if exist(final, k2$) then continue
				push k2$   \\ push to top of stack
				return m, k2$:=""
				delthis++
			end while
			if delthis=0 then
				if not exist(final, k1$) then
					mmm=each(m)
					While mmm
						k2$=eval$(mmm!)
						if k2$=k1$ then continue
						if exist(final, k2$) Else
							Print "unsorted:";k1$, k2$
						end if
					end while
			 		append final, k1$ : Return LL, k1$:=List
				end if
			end if
		end while
		if not exist(final, k$) then append final, k$
	end while
	document doc$
	ret=each(final,1, -2)
	while ret
		doc$=eval$(ret)+" -> "
	end while
	doc$=final$(len(final)-1!)
	Report doc$
	clipboard doc$
}
testthis


TopologicalSort[
    Graph[Flatten[# /. {l_, ld_} :>
        Map[# -> l &,
         DeleteCases[ld, l]]]]] /. {_TopologicalSort -> $Failed} &@
 {{"des_system_lib", {"std", "synopsys", "std_cell_lib",
    "des_system_lib", "dw02", "dw01", "ramlib", "ieee"}},
  {"dw01", {"ieee", "dw01", "dware", "gtech"}},
  {"dw02", {"ieee", "dw02", "dware"}},
  {"dw03", {"std", "synopsys", "dware", "dw03", "dw02", "dw01",
    "ieee", "gtech"}},
  {"dw04", {"dw04", "ieee", "dw01", "dware", "gtech"}},
  {"dw05", {"dw05", "ieee", "dware"}},
  {"dw06", {"dw06", "ieee", "dware"}},
  {"dw07", {"ieee", "dware"}},
  {"dware", {"ieee", "dware"}},
  {"gtech", {"ieee", "gtech"}},
  {"ramlib", {"std", "ieee"}},
  {"std_cell_lib", {"ieee", "std_cell_lib"}},
  {"synopsys", {}}}


module TonelliShanks

legendre(a, p) = powermod(a, (p - 1) ÷ 2, p)

function solve(n::T, p::T) where T <: Union{Int, Int128, BigInt}
    legendre(n, p) != 1 && throw(ArgumentError("$n not a square (mod $p)"))
    local q::T = p - one(p)
    local s::T = 0
    while iszero(q % 2)
        q ÷= 2
        s += one(s)
    end
    if s == one(s)
        r = powermod(n, (p + 1) >> 2, p)
        return r, p - r
    end
    local z::T
    for z in 2:(p - 1)
        p - 1 == legendre(z, p) && break
    end
    local c::T = powermod(z, q, p)
    local r::T = powermod(n, (q + 1) >> 1, p)
    local t::T = powermod(n, q, p)
    local m::T = s
    local t2::T = zero(p)
    while !iszero((t - 1) % p)
        t2 = (t * t) % p
        local i::T
        for i in Base.OneTo(m)
            iszero((t2 - 1) % p) && break
            t2 = (t2 * t2) % p
        end
        b = powermod(c, 1 << (m - i - 1), p)
        r = (r * b) % p
        c = (b * b) % p
        t = (t * c) % p
        m = i
    end
    return r, p - r
end

end  # module TonelliShanks


// version 1.1.3

import java.math.BigInteger

data class Solution(val root1: BigInteger, val root2: BigInteger, val exists: Boolean)

val bigZero = BigInteger.ZERO
val bigOne  = BigInteger.ONE
val bigTwo  = BigInteger.valueOf(2L)
val bigFour = BigInteger.valueOf(4L)
val bigTen  = BigInteger.TEN

fun ts(n: Long, p: Long) = ts(BigInteger.valueOf(n), BigInteger.valueOf(p))

fun ts(n: BigInteger, p: BigInteger): Solution {

    fun powModP(a: BigInteger, e: BigInteger) = a.modPow(e, p)

    fun ls(a: BigInteger) = powModP(a, (p - bigOne) / bigTwo)

    if (ls(n) != bigOne) return Solution(bigZero, bigZero, false)
    var q = p - bigOne
    var ss = bigZero
    while (q.and(bigOne) == bigZero) {
        ss = ss + bigOne
        q = q.shiftRight(1)
    }

    if (ss == bigOne) {
        val r1 = powModP(n, (p + bigOne) / bigFour)
        return Solution(r1, p - r1, true)
    }

    var z = bigTwo
    while (ls(z) != p - bigOne) z = z + bigOne
    var c = powModP(z, q)
    var r = powModP(n, (q + bigOne) / bigTwo)
    var t = powModP(n, q)
    var m = ss

    while (true) {
        if (t == bigOne) return Solution(r, p - r, true)
        var i = bigZero
        var zz = t
        while (zz != bigOne && i < m - bigOne) {
            zz  = zz * zz % p
            i = i + bigOne
        }
        var b = c
        var e = m - i - bigOne
        while (e > bigZero) {
            b = b * b % p
            e = e - bigOne
        }
        r = r * b % p
        c = b * b % p
        t = t * c % p
        m = i
    }
}

fun main(args: Array<String>) {
    val pairs = listOf<Pair<Long, Long>>(
        10L to 13L,
        56L to 101L,
        1030L to 10009L,
        1032L to 10009L,
        44402L to 100049L,
        665820697L to 1000000009L,
        881398088036L to 1000000000039L
    )

    for (pair in pairs) {
        val (n, p) = pair
        val (root1, root2, exists) = ts(n, p)
        println("n = $n")
        println("p = $p")
        if (exists) {
            println("root1 = $root1")
            println("root2 = $root2")
        }
        else println("No solution exists")
        println()
    }

    val bn = BigInteger("41660815127637347468140745042827704103445750172002")
    val bp = bigTen.pow(50) + BigInteger.valueOf(577L)
    val (broot1, broot2, bexists) = ts(bn, bp)
    println("n = $bn")
    println("p = $bp")
    if (bexists) {
        println("root1 = $broot1")
        println("root2 = $broot2")
    }
    else println("No solution exists")
}


constant VALUE = 1, LEFT = 2, RIGHT = 3

constant tree = {1,
                    {2,
                        {4,
                            {7, 0, 0},
                            0},
                        {5, 0, 0}},
                    {3,
                        {6,
                            {8, 0, 0},
                            {9, 0, 0}},
                        0}}

procedure preorder(object tree)
    if sequence(tree) then
        printf(1,"%d ",{tree[VALUE]})
        preorder(tree[LEFT])
        preorder(tree[RIGHT])
    end if
end procedure

procedure inorder(object tree)
    if sequence(tree) then
        inorder(tree[LEFT])
        printf(1,"%d ",{tree[VALUE]})
        inorder(tree[RIGHT])
    end if
end procedure

procedure postorder(object tree)
    if sequence(tree) then
        postorder(tree[LEFT])
        postorder(tree[RIGHT])
        printf(1,"%d ",{tree[VALUE]})
    end if
end procedure

procedure lo(object tree, sequence more)
    if sequence(tree) then
        more &= {tree[LEFT],tree[RIGHT]}
        printf(1,"%d ",{tree[VALUE]})
    end if
    if length(more) > 0 then
        lo(more[1],more[2..$])
    end if
end procedure

procedure level_order(object tree)
    lo(tree,{})
end procedure

puts(1,"preorder:    ")
preorder(tree)
puts(1,'\n')

puts(1,"inorder:     ")
inorder(tree)
puts(1,'\n')

puts(1,"postorder:   ")
postorder(tree)
puts(1,'\n')

puts(1,"level-order: ")
level_order(tree)
puts(1,'\n')


:- module topological_sort.

:- interface.

:- import_module io.
:- pred main(io::di,io::uo) is det.

:- implementation.
:- import_module string, solutions, list, set, require.

:- pred min_element(set(T),pred(T,T),T).
:- mode min_element(in,pred(in,in) is semidet,out) is nondet.
min_element(_,_,_):-fail.
min_element(S,P,X):-
    member(X,S),
    filter((pred(Y::in) is semidet :- P(Y,X)),S,LowerThanX),
    is_empty(LowerThanX).

:- pred topological_sort(set(T),pred(T,T),list(T),list(T)).
:- mode topological_sort(in,(pred((ground >> ground), (ground >> ground)) is semidet),in,out) is nondet.
:- pred topological_sort(set(T),pred(T,T),list(T)).
:- mode topological_sort(in,(pred((ground >> ground), (ground >> ground)) is semidet),out) is nondet.

topological_sort(S,P,Ac,L) :-
    (
	is_empty(S) -> L is Ac
    ;   solutions(
	    pred(X::out) is nondet:-
		min_element(S,P,X)
	 ,  Solutions
	),
	(
	    is_empty(Solutions) -> error("No solution detected.\n")
	; delete_list(Solutions,S,Sprime),
	  append(Solutions,Ac,AcPrime),
	  topological_sort(Sprime,P,AcPrime,L)
	)
    ).

topological_sort(S,P,L) :- topological_sort(S,P,[],L).

:- pred distribute(list(T)::in,{T,list(T)}::out) is det.
distribute([],_):-error("Error in distribute").
distribute([H|T],Z) :- Z = {H,T}.

:- pred db_compare({string,list(string)}::in,{string,list(string)}::in) is semidet.
db_compare({X1,L1},{X2,_}) :- not(X1=X2),list.member(X2,L1).

main(!IO) :-
    Input  = [
"des_system_lib   std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee",
"dw01             ieee dw01 dware gtech",
"dw02             ieee dw02 dware",
"dw03             std synopsys dware dw03 dw02 dw01 ieee gtech",
"dw04             dw04 ieee dw01 dware gtech",
"dw05             dw05 ieee dware",
"dw06             dw06 ieee dware",
"dw07             ieee dware",
"dware            ieee dware",
"gtech            ieee gtech",
"ramlib           std ieee",
"std_cell_lib     ieee std_cell_lib",
"synopsys"],
    Words=list.map(string.words,Input),
    list.map(distribute,Words,Db),
    solutions(pred(X::out) is nondet :- topological_sort(set.from_list(Db),db_compare,X),SortedWordLists),
    list.map(
	     pred({X,Y}::in,Z::out) is det:- X=Z,
	     list.det_head(SortedWordLists),
	     CompileOrder),
    print(CompileOrder,!IO).


import sequtils, strutils, sets, tables, sugar

type StringSet = HashSet[string]

proc topSort(data: var OrderedTable[string, StringSet]) =
  ## Topologically sort the data in place.

  var ranks: Table[string, Natural]   # Maps the keys to a rank.

  # Remove self dependencies.
  for key, values in data.mpairs:
    values.excl key

  # Add extra items (i.e items present in values but not in keys).
  for values in toSeq(data.values):
    for value in values:
      if value notin data:
        data[value] = initHashSet[string]()

  # Find ranks.
  var deps = data   # Working copy of the table.
  var rank = 0
  while deps.len > 0:

    # Find a key with an empty dependency set.
    var keyToRemove: string
    for key, values in deps.pairs:
      if values.card == 0:
        keyToRemove = key
        break
    if keyToRemove.len == 0:
      # Not found: there is a cycle.
      raise newException(ValueError, "Unorderable items found: " & toSeq(deps.keys).join(", "))

    # Assign a rank to the key and remove it from keys and values.
    ranks[keyToRemove] = rank
    inc rank
    deps.del keyToRemove
    for k, v in deps.mpairs:
      v.excl keyToRemove

  # Sort the original data according to the ranks.
  data.sort((x, y) => cmp(ranks[x[0]], ranks[y[0]]))

when isMainModule:

  const Data = {"des_system_lib": ["std", "synopsys", "std_cell_lib",
                                   "des_system_lib", "dw02", "dw01",
                                   "ramlib", "ieee"].toHashSet,
                "dw01": ["ieee", "dw01", "dware", "gtech"].toHashSet,
                "dw02": ["ieee", "dw02", "dware"].toHashSet,
                "dw03": ["std", "synopsys", "dware", "dw03",
                         "dw02", "dw01", "ieee", "gtech"].toHashSet,
                "dw04": ["dw04", "ieee", "dw01", "dware", "gtech"].toHashSet,
                "dw05": ["dw05", "ieee", "dware"].toHashSet,
                "dw06": ["dw06", "ieee", "dware"].toHashSet,
                "dw07": ["ieee", "dware"].toHashSet,
                "dware": ["ieee", "dware"].toHashSet,
                "gtech": ["ieee", "gtech"].toHashSet,
                "ramlib": ["std", "ieee"].toHashSet,
                "std_cell_lib": ["ieee", "std_cell_lib"].toHashSet,
                "synopsys": initHashSet[string]()}.toOrderedTable

  # Process the original data (without cycle).
  echo "Data without cycle. Order after sorting:"
  var data = Data
  try:
    data.topSort()
    for key in data.keys: echo key
  except ValueError:
    echo getCurrentExceptionMsg()

  # Process the modified data (with a cycle).
  echo "\nData with a cycle:"
  data = Data
  data["dw01"].incl "dw04"
  try:
    data.topSort()
    for key in data.keys: echo key
  except ValueError:
    echo getCurrentExceptionMsg()


proc pow*[T: SomeInteger](x, n, p: T): T =
  var t = x mod p
  var e = n
  result = 1
  while e > 0:
    if (e and 1) == 1:
      result = result * t mod p
    t = t * t mod p
    e = e shr 1

proc legendre*[T: SomeInteger](a, p: T): T = pow(a, (p-1) shr 1, p)

proc tonelliShanks*[T: SomeInteger](n, p: T): T =
  # Check that n is indeed a square.
  if legendre(n, p) != 1:
    raise newException(ValueError, "Not a square")

  # Factor out power of 2 from p-1.
  var q = p - 1
  var s = 0
  while (q and 1) == 0:
    s += 1
    q = q shr 1

  if s == 1:
    return pow(n, (p+1) shr 2, p)

  # Select a non-square z such as (z | p) = -1.
  var z = 2
  while legendre(z, p) != p - 1:
    z += 1

  var
    c = pow(z, q, p)
    t = pow(n, q, p)
    m = s
  result = pow(n, (q+1) shr 1, p)
  while t != 1:
    var
      i = 1
      z = t * t mod p
    while z != 1 and i < m-1:
      i += 1
      z = z * z mod p

    var b = pow(c, 1 shl (m-i-1), p)
    c = b * b mod p
    t = t * c mod p
    m = i
    result = result * b mod p

when isMainModule:
  proc run(n, p: SomeInteger) =
    try:
      let r = tonelliShanks(n, p)
      echo r, " ", p-r
    except ValueError:
      echo getCurrentExceptionMsg()

  run(10, 13)
  run(56, 101)
  run(1030, 10009)
  run(1032, 10009)
  run(44402, 100049)
  run(665820697, 1000000009)


let tonelli n p =
  let open Z in
  let two = ~$2 in
  let pp = pred p in
  let pph = pred p / two in
  let pow_mod_p a e = powm a e p in
  let legendre_p a = pow_mod_p a pph in

  if legendre_p n <> one then None
  else
    let s = trailing_zeros pp in
    if s = 1 then
      let r = pow_mod_p n (succ p / ~$4) in
      Some (r, p - r)
    else
      let q = pp asr s in
      let z =
        let rec find_non_square z =
          if legendre_p z = pp then z else find_non_square (succ z)
        in
        find_non_square two
      in
      let rec loop c r t m =
        if t = one then (r, p - r)
        else
          let mp = pred m in
          let rec find_i n i =
            if n = one || i >= mp then i else find_i (n * n mod p) (succ i)
          in
          let rec exp_pow2 b e =
            if e <= zero then b else exp_pow2 (b * b mod p) (pred e)
          in
          let i = find_i t zero in
          let b = exp_pow2 c (mp - i) in
          let c = b * b mod p in
          loop c (r * b mod p) (t * c mod p) i
      in
      Some
        (loop (pow_mod_p z q) (pow_mod_p n (succ q / two)) (pow_mod_p n q) ~$s)

let () =
  let open Z in
  [
    (~$9, ~$11);
    (~$10, ~$13);
    (~$56, ~$101);
    (~$1030, ~$10009);
    (~$1032, ~$10009);
    (~$44402, ~$100049);
    (~$665820697, ~$1000000009);
    (~$881398088036, ~$1000000000039);
    ( of_string "41660815127637347468140745042827704103445750172002",
      pow ~$10 50 + ~$577 );
  ]
  |> List.iter (fun (n, p) ->
         Printf.printf "n = %s\np = %s\n%!" (to_string n) (to_string p);
         match tonelli n p with
         | Some (r1, r2) ->
             Printf.printf "root1 = %s\nroot2 = %s\n\n%!" (to_string r1)
               (to_string r2)
         | None -> print_endline "No solution exists\n")


open System
open System.IO

type Tree<'a> =
   | Tree of 'a * Tree<'a> * Tree<'a>
   | Empty

let rec inorder tree =
    seq {
      match tree with
          | Tree(x, left, right) ->
               yield! inorder left
               yield x
               yield! inorder right
          | Empty -> ()
    }

let rec preorder tree =
    seq {
      match tree with
          | Tree(x, left, right) ->
               yield x
               yield! preorder left
               yield! preorder right
          | Empty -> ()
    }

let rec postorder tree =
    seq {
      match tree with
          | Tree(x, left, right) ->
               yield! postorder left
               yield! postorder right
               yield x
          | Empty -> ()
    }

let levelorder tree =
    let rec loop queue =
        seq {
            match queue with
            | [] -> ()
            | (Empty::tail) -> yield! loop tail
            | (Tree(x, l, r)::tail) ->
                yield x
                yield! loop (tail @ [l; r])
        }
    loop [tree]

[<EntryPoint>]
let main _ =
    let tree =
        Tree (1,
              Tree (2,
                    Tree (4,
                          Tree (7, Empty, Empty),
                          Empty),
                    Tree (5, Empty, Empty)),
              Tree (3,
                    Tree (6,
                          Tree (8, Empty, Empty),
                          Tree (9, Empty, Empty)),
                    Empty))

    let show x = printf "%d " x

    printf "preorder:    "
    preorder tree   |> Seq.iter show
    printf "\ninorder:     "
    inorder tree    |> Seq.iter show
    printf "\npostorder:   "
    postorder tree  |> Seq.iter show
    printf "\nlevel-order: "
    levelorder tree |> Seq.iter show
    0