package main

import (
	"container/heap"
	"fmt"
)

// A PriorityQueue implements heap.Interface and holds Items.
type PriorityQueue struct {
	items []Vertex
	m     map[Vertex]int // value to index
	pr    map[Vertex]int // value to priority
}

func (pq *PriorityQueue) Len() int           { return len(pq.items) }
func (pq *PriorityQueue) Less(i, j int) bool { return pq.pr[pq.items[i]] < pq.pr[pq.items[j]] }
func (pq *PriorityQueue) Swap(i, j int) {
	pq.items[i], pq.items[j] = pq.items[j], pq.items[i]
	pq.m[pq.items[i]] = i
	pq.m[pq.items[j]] = j
}
func (pq *PriorityQueue) Push(x interface{}) {
	n := len(pq.items)
	item := x.(Vertex)
	pq.m[item] = n
	pq.items = append(pq.items, item)
}
func (pq *PriorityQueue) Pop() interface{} {
	old := pq.items
	n := len(old)
	item := old[n-1]
	pq.m[item] = -1
	pq.items = old[0 : n-1]
	return item
}

// update modifies the priority of an item in the queue.
func (pq *PriorityQueue) update(item Vertex, priority int) {
	pq.pr[item] = priority
	heap.Fix(pq, pq.m[item])
}
func (pq *PriorityQueue) addWithPriority(item Vertex, priority int) {
	heap.Push(pq, item)
	pq.update(item, priority)
}

const (
	Infinity      = int(^uint(0) >> 1)
	Uninitialized = -1
)

func Dijkstra(g Graph, source Vertex) (dist map[Vertex]int, prev map[Vertex]Vertex) {
	vs := g.Vertices()
	dist = make(map[Vertex]int, len(vs))
	prev = make(map[Vertex]Vertex, len(vs))
	sid := source
	dist[sid] = 0
	q := &PriorityQueue{
		items: make([]Vertex, 0, len(vs)),
		m:     make(map[Vertex]int, len(vs)),
		pr:    make(map[Vertex]int, len(vs)),
	}
	for _, v := range vs {
		if v != sid {
			dist[v] = Infinity
		}
		prev[v] = Uninitialized
		q.addWithPriority(v, dist[v])
	}
	for len(q.items) != 0 {
		u := heap.Pop(q).(Vertex)
		for _, v := range g.Neighbors(u) {
			alt := dist[u] + g.Weight(u, v)
			if alt < dist[v] {
				dist[v] = alt
				prev[v] = u
				q.update(v, alt)
			}
		}
	}
	return dist, prev
}

// A Graph is the interface implemented by graphs that
// this algorithm can run on.
type Graph interface {
	Vertices() []Vertex
	Neighbors(v Vertex) []Vertex
	Weight(u, v Vertex) int
}

// Nonnegative integer ID of vertex
type Vertex int

// sg is a graph of strings that satisfies the Graph interface.
type sg struct {
	ids   map[string]Vertex
	names map[Vertex]string
	edges map[Vertex]map[Vertex]int
}

func newsg(ids map[string]Vertex) sg {
	g := sg{ids: ids}
	g.names = make(map[Vertex]string, len(ids))
	for k, v := range ids {
		g.names[v] = k
	}
	g.edges = make(map[Vertex]map[Vertex]int)
	return g
}
func (g sg) edge(u, v string, w int) {
	if _, ok := g.edges[g.ids[u]]; !ok {
		g.edges[g.ids[u]] = make(map[Vertex]int)
	}
	g.edges[g.ids[u]][g.ids[v]] = w
}
func (g sg) path(v Vertex, prev map[Vertex]Vertex) (s string) {
	s = g.names[v]
	for prev[v] >= 0 {
		v = prev[v]
		s = g.names[v] + s
	}
	return s
}
func (g sg) Vertices() []Vertex {
	vs := make([]Vertex, 0, len(g.ids))
	for _, v := range g.ids {
		vs = append(vs, v)
	}
	return vs
}
func (g sg) Neighbors(u Vertex) []Vertex {
	vs := make([]Vertex, 0, len(g.edges[u]))
	for v := range g.edges[u] {
		vs = append(vs, v)
	}
	return vs
}
func (g sg) Weight(u, v Vertex) int { return g.edges[u][v] }

func main() {
	g := newsg(map[string]Vertex{
		"a": 1,
		"b": 2,
		"c": 3,
		"d": 4,
		"e": 5,
		"f": 6,
	})
	g.edge("a", "b", 7)
	g.edge("a", "c", 9)
	g.edge("a", "f", 14)
	g.edge("b", "c", 10)
	g.edge("b", "d", 15)
	g.edge("c", "d", 11)
	g.edge("c", "f", 2)
	g.edge("d", "e", 6)
	g.edge("e", "f", 9)

	dist, prev := Dijkstra(g, g.ids["a"])
	fmt.Printf("Distance to %s: %d, Path: %s\n", "e", dist[g.ids["e"]], g.path(g.ids["e"], prev))
	fmt.Printf("Distance to %s: %d, Path: %s\n", "f", dist[g.ids["f"]], g.path(g.ids["f"], prev))
}


(for N (627615 39390 588225 393900588225)
   (for ((A . I) N  T  (sum format (chop I)))
      (T (> 10 I)
         (prinl N " has additive persistance " (dec A) " and digital root of " I ";") ) ) )


 digrt: Proc Options(main);
 /* REXX ***************************************************************
 * Test digroot
 **********************************************************************/

 Call digrtst('7');
 Call digrtst('627615');
 Call digrtst('39390');
 Call digrtst('588225');
 Call digrtst('393900588225');

 digrtst: Proc(n);
 Dcl n Char(100) Var;
 Dcl dr Pic'9';
 Dcl p  Dec Fixed(5);
 Call digroot(n,dr,p);
 Put Edit(n,dr,p)(skip,a,col(20),f(1),f(3));
 End;

 digroot: Proc(n,dr,p);
 /**********************************************************************
 * Compute the digital root and persistence of the given decimal number
 * 27.07.2012 Walter Pachl (derived from REXX)
 **********************************************************************/
 Dcl n Char(100) Var;
 Dcl dr Pic'9';
 Dcl p  Dec Fixed(5);
 Dcl s  Pic'(14)Z9';
 Dcl v  Char(100) Var;
 p=0;
 v=strip(n);                         /* copy the number               */
 If length(v)=1 Then
   dr=v;
 Else Do;
   Do While(length(v)>1);            /* more than one digit in v      */
     s=0;                            /* initialize sum                */
     p+=1;                           /* increment persistence         */
     Do i=1 To length(v);            /* loop over all digits          */
       dig=substr(v,i,1);            /* pick a digit                  */
       s=s+dig;                      /* add to the new sum            */
       End;
   /*Put Skip Data(v,p,s);*/
     v=strip(s);                     /* the 'new' number              */
     End;
   dr=Decimal(s,1,0);
   End;
 Return;
 End;

 strip: Proc(x) Returns(Char(100) Var);
 Dcl x Char(*);
 Dcl res Char(100) Var Init('');
 Do i=1 To length(x);
   If substr(x,i,1)>' ' Then
     res=res||substr(x,i,1);
   End;
 Return(res);
 End;
 End;


{-# LANGUAGE FlexibleContexts #-}
import Data.Array
import Data.Array.MArray
import Data.Array.ST
import Control.Monad.ST
import Control.Monad (foldM)
import Data.Set as S

dijkstra :: (Ix v, Num w, Ord w, Bounded w) => v -> v -> Array v [(v,w)] -> (Array v w, Array v v)
dijkstra src invalid_index adj_list = runST $ do
  min_distance <- newSTArray b maxBound
  writeArray min_distance src 0
  previous <- newSTArray b invalid_index
  let aux vertex_queue =
        case S.minView vertex_queue of
          Nothing -> return ()
          Just ((dist, u), vertex_queue') ->
            let edges = adj_list ! u
                f vertex_queue (v, weight) = do
                  let dist_thru_u = dist + weight
                  old_dist <- readArray min_distance v
                  if dist_thru_u >= old_dist then
                    return vertex_queue
                  else do
                    let vertex_queue' = S.delete (old_dist, v) vertex_queue
                    writeArray min_distance v dist_thru_u
                    writeArray previous v u
                    return $ S.insert (dist_thru_u, v) vertex_queue'
            in
            foldM f vertex_queue' edges >>= aux  -- note that aux is being called within its own definition (i.e. aux is recursive). The foldM only iterates on the neighbours of v, it does not execute the while loop itself in Dijkstra's
  aux (S.singleton (0, src))
  m <- freeze min_distance
  p <- freeze previous
  return (m, p)
  where b = bounds adj_list
        newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
        newSTArray = newArray

shortest_path_to :: (Ix v) => v -> v -> Array v v -> [v]
shortest_path_to target invalid_index previous =
  aux target [] where
    aux vertex acc | vertex == invalid_index = acc
                   | otherwise = aux (previous ! vertex) (vertex : acc)

adj_list :: Array Char [(Char, Int)]
adj_list = listArray ('a', 'f') [ [('b',7), ('c',9), ('f',14)],
                                  [('a',7), ('c',10), ('d',15)],
                                  [('a',9), ('b',10), ('d',11), ('f',2)],
                                  [('b',15), ('c',11), ('e',6)],
                                  [('d',6), ('f',9)],
                                  [('a',14), ('c',2), ('e',9)] ]

main :: IO ()
main = do
  let (min_distance, previous) = dijkstra 'a' ' ' adj_list
  putStrLn $ "Distance from a to e: " ++ show (min_distance ! 'e')
  let path = shortest_path_to 'e' ' ' previous
  putStrLn $ "Path: " ++ show path


100H: /* SHOW THE DIGITAL ROOT AND PERSISTENCE OF SOME NUMBERS              */

   /* BDOS SYSTEM CALL */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   /* PRINTS A BYTE AS A CHARACTER */
   PRINT$CHAR: PROCEDURE( CH ); DECLARE CH BYTE; CALL BDOS( 2, CH ); END;
   /* PRINTS A BYTE AS A NUMBER */
   PRINT$BYTE: PROCEDURE( N );
      DECLARE N BYTE;
      DECLARE ( V, D2 ) BYTE;
      IF ( V := N / 10 ) <> 0 THEN DO;
         D2 = V MOD 10;
         IF ( V := V / 10 ) <> 0 THEN CALL PRINT$CHAR( '0' + V );
         CALL PRINT$CHAR( '0' + D2 );
      END;
      CALL PRINT$CHAR( '0' + N MOD 10 );
   END PRINT$BYTE;
   /* PRINTS A $ TERMINATED STRING */
   PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;

   /* PRINTS N1, N2, N3 AS A SINGLE NUMBER                       */
   /*        N1, N2, N3 MUST ALL BE BETWEEN 0 AND 9999 INCLUSIVE */
   PRINT$NUMBER3: PROCEDURE( N1, N2, N3 );
      DECLARE ( N1, N2, N3 ) ADDRESS;
      DECLARE V ADDRESS, N$STR( 14 ) BYTE, ( W, I, J ) BYTE;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      /* ADD THE DIGITS OF THE THREE NUMBERS TO N$STR */
      DO I = 0 TO 2;
         DO CASE I;
            V = N3;
            V = N2;
            V = N1;
         END;
         DO J = 1 TO 4;
            N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
            V = V / 10;
         END;
      END;
      /* SPACE FILL THE REMAINDER OF THE NUMBER */
      I = W;
      DO WHILE( I > 0 );
         N$STR( I := I - 1 ) = ' ';
      END;
      /* SUPPRESS LEADING ZEROS */
      DO WHILE( W < LAST( N$STR ) - 1 AND N$STR( W ) = '0' );
         N$STR( W ) = ' ';
         W = W + 1;
      END;
      CALL PRINT$STRING( .N$STR );
   END PRINT$NUMBER3;

   /* CALCULATES THE DIGITAL ROOT AND PERSISTENCE OF AN INTEGER IN BASE 10 */
   /* IN ORDER TO ALLOW FOR NUMBERS LARGER THAN 2^15, THE NUMBER IS PASSED */
   /* AS THE UPPER, MIDDLE AND LOWER DIGITS IN N1, N2 AND N3               */
   /* E.G. 393900588225 CAN BE PROCESSED BY N1=3939, N2=0058, N3=8225      */
   FIND$DIGITAL$ROOT: PROCEDURE( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR );
      DECLARE ( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR ) ADDRESS;
      DECLARE DIGITAL$ROOT BASED ROOT$PTR        BYTE;
      DECLARE PERSISTENCE  BASED PERSISTENCE$PTR BYTE;

      SUM$DIGITS: PROCEDURE( N ) ADDRESS;
         DECLARE N      ADDRESS;
         DECLARE DIGITS ADDRESS, SUM BYTE;
         DIGITS = N;
         SUM    = 0;
         DO WHILE DIGITS > 0;
            SUM    = SUM + ( DIGITS MOD 10 );
            DIGITS =         DIGITS  /  10;
         END;
         RETURN SUM;
      END SUM$DIGITS;

      DIGITAL$ROOT = SUM$DIGITS( N1 ) + SUM$DIGITS( N2 ) + SUM$DIGITS( N3 );
      PERSISTENCE = 1;
      DO WHILE( DIGITAL$ROOT > 9 );
         PERSISTENCE  = PERSISTENCE + 1;
         DIGITAL$ROOT = SUM$DIGITS( DIGITAL$ROOT );
      END;
   END FIND$DIGITAL$ROOT ;

   /* CALCULATES AND PRINTS THE DIGITAL ROOT AND PERSISTENCE OF THE */
   /* NUMBER FORMED FROM THE CONCATENATION OF  N1, N2 AND N3        */
   PRINT$DR$AND$PERSISTENCE: PROCEDURE( N1, N2, N3 );
      DECLARE ( N1, N2, N3 ) ADDRESS;
      DECLARE ( DIGITAL$ROOT, PERSISTENCE ) BYTE;
      CALL FIND$DIGITAL$ROOT( N1, N2, N3, .DIGITAL$ROOT, .PERSISTENCE );
      CALL PRINT$NUMBER3( N1, N2, N3 );
      CALL PRINT$STRING( .': DIGITAL ROOT: $' );
      CALL PRINT$BYTE( DIGITAL$ROOT );
      CALL PRINT$STRING( .', PERSISTENCE: $' );
      CALL PRINT$BYTE( PERSISTENCE );
      CALL PRINT$STRING( .( 0DH, 0AH, '$' ) );
   END PRINT$DR$AND$PERSISTENCE;

   /* TEST THE DIGITAL ROOT AND PERSISTENCE PROCEDURES */
   CALL PRINT$DR$ANDPERSISTENCE(    0,   62, 7615 );
   CALL PRINT$DR$ANDPERSISTENCE(    0,    3, 9390 );
   CALL PRINT$DR$ANDPERSISTENCE(    0,   58, 8225 );
   CALL PRINT$DR$ANDPERSISTENCE( 3939, 0058, 8225 );

EOF


digital = (x) :
   dr = x string  # Digital Root.
   ap = 0  # Additive Persistence.
   while (dr length > 1) :
      sum = 0
      dr length times (i): sum = sum + dr(i) number integer.
      dr = sum string
      ap++
   .
   (x, " has additive persistence ", ap,
      " and digital root ", dr, ";\n") join print
.

digital(627615)
digital(39390)
digital(588225)
digital(393900588225)


function Get-DigitalRoot ($n)
{
    function Get-Digitalsum ($n)
    {
        if ($n -lt 10) {$n}
        else {
            ($n % 10) + (Get-DigitalSum ([math]::Floor($n / 10)))
        }
    }

    $ap = 0
    do {$n = Get-DigitalSum $n; $ap++}
    until ($n -lt 10)
    $DigitalRoot = [pscustomobject]@{
        'Sum' = $n
        'Additive Persistence' = $ap
    }
    $DigitalRoot
}


import Algorithms as algo;
import Mathematics as math;
import Text as text;

class Edge {
	_to = none;
	_name = none;
	_cost = none;
	constructor( to_, name_, cost_ ) {
		_to = to_;
		_name = name_;
		_cost = real( cost_ );
	}
	to_string() {
		return ( "{}<{}>".format( _name, _cost ) );
	}
}

class Path {
	_id = none;
	_from = none;
	_cost = none;
	_names = none;
	constructor( toName_, ids_, names_ ) {
		_id = ids_[toName_];
		_names = names_;
		_cost = math.INFINITY;
	}
	less( other_ ) {
		return ( _cost < other_._cost );
	}
	update( from_, cost_ ) {
		_from = from_;
		_cost = cost_;
	}
	to_string() {
		return ( "{} via {} at cost {}".format( _names[_id], _from != none ? _names[_from] : none, _cost ) );
	}
}

class Graph {
	_neighbours = [];
	_ids = {};
	_names = [];
	add_node( name_ ) {
		if ( name_ ∉ _ids ) {
			_ids[name_] = size( _names );
			_names.push( name_ );
		}
	}
	add_edge( from_, to_, cost_ ) {
		assert( ( from_ ∈ _ids ) && ( to_ ∈ _ids ) );
		from = _ids[from_];
		to = _ids[to_];
		if ( from >= size( _neighbours ) ) {
			_neighbours.resize( from + 1, [] );
		}
		_neighbours[from].push( Edge( to, to_, cost_ ) );
	}
	shortest_paths( from_ ) {
		assert( from_ ∈ _ids );
		from = _ids[from_];
		paths = algo.materialize( algo.map( _names, @[_ids, _names]( name ) { Path( name, _ids, _names ); } ), list );
		paths[from].update( none, 0.0 );
		todo = algo.sorted( paths, @(x){-x._cost;} );
		while ( size( todo ) > 0 ) {
			node = todo[-1]._id;
			todo.resize( size( todo ) - 1, none );
			if ( node >= size( _neighbours ) ) {
				continue;
			}
			neighbours = _neighbours[node];
			for ( n : neighbours ) {
				newCost = n._cost + paths[node]._cost;
				if ( newCost < paths[n._to]._cost ) {
					paths[n._to].update( node, newCost );
				}
			}
			todo = algo.sorted( todo, @(x){-x._cost;} );
		}
		return ( paths );
	}
	path( paths_, to_ ) {
		assert( to_ ∈ _ids );
		to = _ids[to_];
		p = [to_];
		while ( paths_[to]._from != none ) {
			to = paths_[to]._from;
			p.push( _names[to] );
		}
		return ( algo.materialize( algo.reversed( p ), list ) );
	}
	to_string() {
		s = "";
		for ( i, n : algo.enumerate( _neighbours ) ) {
			s += "{} -> {}\n".format( _names[i], n );
		}
	}
}

main() {
	g = Graph();
	confStr = input();
	if ( confStr == none ) {
		return ( 1 );
	}
	conf = algo.materialize( algo.map( text.split( confStr ), integer ), tuple );
	assert( size( conf ) == 2 );
	for ( _ : algo.range( conf[0] ) ) {
		line = input();
		if ( line == none ) {
			return ( 1 );
		}
		g.add_node( line.strip() );
	}
	for ( _ : algo.range( conf[1] ) ) {
		line = input();
		if ( line == none ) {
			return ( 1 );
		}
		g.add_edge( algo.materialize( text.split( line.strip() ), tuple )... );
	}
	print( string( g ) );
	paths = g.shortest_paths( "a" );
	for ( p : paths ) {
		print( "{}\n".format( p ) );
	}
	print( "{}\n".format( g.path( paths, "e" ) ) );
	print( "{}\n".format( g.path( paths, "f" ) ) );
}


procedure main(A)
    graph := getGraph()
    repeat {
        writes("What is the start node? ")
        start := \graph.nodes[read()] | stop()
        writes("What is the finish node? ")
        finish := read() | stop()

        QMouse(graph,start,finish)
        waitForCompletion() # block until all quantum mice have finished

        showPath(getBestMouse(),start.name,finish)
        cleanGraph(graph)
        }
end

procedure getGraph()
    graph := Graph(table(),table())
    write("Enter edges as 'n1,n2,weight' (blank line terminates)")
    repeat {
        if *(line := trim(read())) = 0 then break
        line ? {
            n1 := 1(tab(upto(',')),move(1))
            n2 := 1(tab(upto(',')),move(1))
            w  := tab(0)
            /graph.nodes[n1] := Node(n1,set())
            /graph.nodes[n2] := Node(n2,set())
            insert(graph.nodes[n1].targets,graph.nodes[n2])
            graph.weights[n1||":"||n2] := w
            }
        }
    return graph
end

procedure showPath(mouse,start,finish)
    if \mouse then {
        path := mouse.getPath()
        writes("Weight: ",path.weight," -> ")
        every writes(" ",!path.nodes)
        write("\n")
        }
    else write("No path from ",start," to ",finish,"\n")
end

# A "Quantum-mouse" for traversing graphs.  Each mouse lives for just
#  one node but can spawn additional mice to search adjoining nodes.

global qMice, goodMice, region, qMiceEmpty

record Graph(nodes,weights)
record Node(name,targets,weight)
record Path(weight, nodes)

class QMouse(graph, loc, finish, path)

    method getPath(); return path; end
    method atEnd(); return (finish == loc.name); end

    method visit(n)  # Visit if we don't already have a cheaper route to n
        newWeight := path.weight + graph.weights[loc.name||":"||n.name]
        critical region[n]: if /n.weight | (newWeight < n.weight) then {
            n.weight := newWeight
            unlock(region[n])
            return n
            }
    end

initially (g, l, f, p)
    initial {   # Construct critical region mutexes and completion condvar
        qMiceEmpty := condvar()
        region := table()
        every region[n := !g.nodes] := mutex()
        qMice := mutex(set())
        cleanGraph(g)
        }
    graph := g
    loc := l
    finish := f
    /p := Path(0,[])
    path := Path(p.weight,copy(p.nodes))
    if *path.nodes > 0 then
        path.weight +:= g.weights[path.nodes[-1]||":"||loc.name]
    put(path.nodes, loc.name)
    insert(qMice,self)
    thread {
        if atEnd() then insert(goodMice, self)    # This mouse found a finish
        every QMouse(g,visit(!loc.targets),f,path)
        delete(qMice, self)                       # Kill this mouse
        if *qMice=0 then signal(qMiceEmpty)       # All mice are dead
        }
end

procedure cleanGraph(graph)
    every (!graph.nodes).weight := &null
    goodMice := mutex(set())
end

procedure getBestMouse()
    every mouse := !goodMice do  { # Locate shortest path
        weight := mouse.getPath().weight
        /minPathWeight := weight
        if minPathWeight >=:= weight then bestMouse := mouse
        }
    return bestMouse
end

procedure waitForCompletion()
    critical qMiceEmpty: while *qMice > 0 do wait(qMiceEmpty)
end


digit_sum(N, Base, Sum):-
    digit_sum(N, Base, Sum, 0).

digit_sum(N, Base, Sum, S1):-
    N < Base,
    !,
    Sum is S1 + N.
digit_sum(N, Base, Sum, S1):-
    divmod(N, Base, M, Digit),
    S2 is S1 + Digit,
    digit_sum(M, Base, Sum, S2).

digital_root(N, Base, AP, DR):-
    digital_root(N, Base, AP, DR, 0).

digital_root(N, Base, AP, N, AP):-
    N < Base,
    !.
digital_root(N, Base, AP, DR, AP1):-
    digit_sum(N, Base, Sum),
    AP2 is AP1 + 1,
    digital_root(Sum, Base, AP, DR, AP2).

test_digital_root(N, Base):-
    digital_root(N, Base, AP, DR),
    writef('%w has additive persistence %w and digital root %w.\n', [N, AP, DR]).

main:-
    test_digital_root(627615, 10),
    test_digital_root(39390, 10),
    test_digital_root(588225, 10),
    test_digital_root(393900588225, 10),
    test_digital_root(685943443231217865409, 10).


; if you just want the DigitalRoot
; Procedure.q DigitalRoot(N.q) apparently will do
; i must have missed something because it seems too simple
; http://en.wikipedia.org/wiki/Digital_root#Congruence_formula

Procedure.q DigitalRoot(N.q)
Protected M.q=N%9
if M=0:ProcedureReturn 9
Else  :ProcedureReturn M:EndIf
EndProcedure

; there appears to be a proof guarantying that Len(N$)<=1 for some X
; http://en.wikipedia.org/wiki/Digital_root#Proof_that_a_constant_value_exists

Procedure.s DigitalRootandPersistance(N.q)
Protected r.s,t.s,X.q,M.q,persistance,N$=Str(N)
M=DigitalRoot(N.q) ; just a test to see if we get the same DigitalRoot via the Congruence_formula

Repeat
X=0:Persistance+1

For i=1 to Len(N$)       ; finding X as the sum of the digits of N
X+Val(Mid(N$,i,1))
Next

N$=Str(X)
If Len(N$)<=1:Break:EndIf ; If Len(N$)<=1:Break:EndIf
Forever

If Not (X-M)=0:t.s=" Error in my logic":else:t.s=" ok":EndIf

r.s=RSet(Str(N),15)+" has additive persistance "+Str(Persistance)
r.s+" and digital root of X(slow) ="+Str(X)+" M(fast) ="+Str(M)+t.s
ProcedureReturn r.s
EndProcedure

NewList Nlist.q()
AddElement(Nlist()) : Nlist()=627615
AddElement(Nlist()) : Nlist()=39390
AddElement(Nlist()) : Nlist()=588225
AddElement(Nlist()) : Nlist()=393900588225

FirstElement(Nlist())

ForEach Nlist()
N.q=Nlist()
; cw(DigitalRootandPersistance(N))
Debug DigitalRootandPersistance(N)
Next


NB. verbs and adverb
parse_table=: ;:@:(LF&= [;._2 -.&CR)
mp=: $:~ :(+/ .*)                       NB. matrix product
min=: <./                               NB. minimum
Index=: (i.`)(`:6)                      NB. Index adverb

dijkstra=: dyad define
  'LINK WEIGHT'=. , (0 _ ,. 2) <;.3 y
  'SOURCE SINK'=. |: LINK
  FRONTIER=. , < {. x
  GOAL=. {: x
  enumerate=. 2&([\)&.>
  while. FRONTIER do.
    PATH_MASK=. FRONTIER (+./@:(-:"1/)&:>"0 _~ enumerate)~ LINK
    I=. PATH_MASK min [email protected]:mp WEIGHTS
    PATH=. I >@{ FRONTIER
    STATE=. {: PATH
    if. STATE -: GOAL do. PATH return. end.
    FRONTIER=. (<<< I) { FRONTIER  NB. elision
    ADJACENCIES=. (STATE = SOURCE) # SINK
    FRONTIER=. FRONTIER , PATH <@,"1 0 ADJACENCIES
  end.
  EMPTY
)

NB. The specific problem

INPUT=: noun define
a	 b	 7
a	 c	 9
a	 f	 14
b	 c	 10
b	 d	 15
c	 d	 11
c	 f	 2
d	 e	 6
e	 f	 9
)

T=: parse_table INPUT
NAMED_LINKS=: _ 2 {. T
NODES=: ~. , NAMED_LINKS                NB. vector of boxed names
NUMBERED_LINKS=: NODES i. NAMED_LINKS
WEIGHTS=: _ ".&> _ _1 {. T
GRAPH=: NUMBERED_LINKS ,. WEIGHTS NB. GRAPH is the numerical representation

TERMINALS=: NODES (i. ;:) 'a e'

NODES {~ TERMINALS dijkstra GRAPH

Note 'Output'
┌─┬─┬─┬─┐
│a│c│d│e│
└─┴─┴─┴─┘

TERMINALS and GRAPH are integer arrays:

   TERMINALS
0 5

   GRAPH
0 1  7
0 2  9
0 3 14
1 2 10
1 4 15
2 4 11
2 3  2
4 5  6
5 3  9
)


import java.io.*;
import java.util.*;

public class Dijkstra {
   private static final Graph.Edge[] GRAPH = {
      new Graph.Edge("a", "b", 7),
      new Graph.Edge("a", "c", 9),
      new Graph.Edge("a", "f", 14),
      new Graph.Edge("b", "c", 10),
      new Graph.Edge("b", "d", 15),
      new Graph.Edge("c", "d", 11),
      new Graph.Edge("c", "f", 2),
      new Graph.Edge("d", "e", 6),
      new Graph.Edge("e", "f", 9),
   };
   private static final String START = "a";
   private static final String END = "e";

   public static void main(String[] args) {
      Graph g = new Graph(GRAPH);
      g.dijkstra(START);
      g.printPath(END);
      //g.printAllPaths();
   }
}

class Graph {
   private final Map<String, Vertex> graph; // mapping of vertex names to Vertex objects, built from a set of Edges

   /** One edge of the graph (only used by Graph constructor) */
   public static class Edge {
      public final String v1, v2;
      public final int dist;
      public Edge(String v1, String v2, int dist) {
         this.v1 = v1;
         this.v2 = v2;
         this.dist = dist;
      }
   }

   /** One vertex of the graph, complete with mappings to neighbouring vertices */
  public static class Vertex implements Comparable<Vertex>{
	public final String name;
	public int dist = Integer.MAX_VALUE; // MAX_VALUE assumed to be infinity
	public Vertex previous = null;
	public final Map<Vertex, Integer> neighbours = new HashMap<>();

	public Vertex(String name)
	{
		this.name = name;
	}

	private void printPath()
	{
		if (this == this.previous)
		{
			System.out.printf("%s", this.name);
		}
		else if (this.previous == null)
		{
			System.out.printf("%s(unreached)", this.name);
		}
		else
		{
			this.previous.printPath();
			System.out.printf(" -> %s(%d)", this.name, this.dist);
		}
	}

	public int compareTo(Vertex other)
	{
		if (dist == other.dist)
			return name.compareTo(other.name);

		return Integer.compare(dist, other.dist);
	}

	@Override public String toString()
	{
		return "(" + name + ", " + dist + ")";
	}
}

   /** Builds a graph from a set of edges */
   public Graph(Edge[] edges) {
      graph = new HashMap<>(edges.length);

      //one pass to find all vertices
      for (Edge e : edges) {
         if (!graph.containsKey(e.v1)) graph.put(e.v1, new Vertex(e.v1));
         if (!graph.containsKey(e.v2)) graph.put(e.v2, new Vertex(e.v2));
      }

      //another pass to set neighbouring vertices
      for (Edge e : edges) {
         graph.get(e.v1).neighbours.put(graph.get(e.v2), e.dist);
         //graph.get(e.v2).neighbours.put(graph.get(e.v1), e.dist); // also do this for an undirected graph
      }
   }

   /** Runs dijkstra using a specified source vertex */
   public void dijkstra(String startName) {
      if (!graph.containsKey(startName)) {
         System.err.printf("Graph doesn't contain start vertex \"%s\"\n", startName);
         return;
      }
      final Vertex source = graph.get(startName);
      NavigableSet<Vertex> q = new TreeSet<>();

      // set-up vertices
      for (Vertex v : graph.values()) {
         v.previous = v == source ? source : null;
         v.dist = v == source ? 0 : Integer.MAX_VALUE;
         q.add(v);
      }

      dijkstra(q);
   }

   /** Implementation of dijkstra's algorithm using a binary heap. */
   private void dijkstra(final NavigableSet<Vertex> q) {
      Vertex u, v;
      while (!q.isEmpty()) {

         u = q.pollFirst(); // vertex with shortest distance (first iteration will return source)
         if (u.dist == Integer.MAX_VALUE) break; // we can ignore u (and any other remaining vertices) since they are unreachable

         //look at distances to each neighbour
         for (Map.Entry<Vertex, Integer> a : u.neighbours.entrySet()) {
            v = a.getKey(); //the neighbour in this iteration

            final int alternateDist = u.dist + a.getValue();
            if (alternateDist < v.dist) { // shorter path to neighbour found
               q.remove(v);
               v.dist = alternateDist;
               v.previous = u;
               q.add(v);
            }
         }
      }
   }

   /** Prints a path from the source to the specified vertex */
   public void printPath(String endName) {
      if (!graph.containsKey(endName)) {
         System.err.printf("Graph doesn't contain end vertex \"%s\"\n", endName);
         return;
      }

      graph.get(endName).printPath();
      System.out.println();
   }
   /** Prints the path from the source to every vertex (output order is not guaranteed) */
   public void printAllPaths() {
      for (Vertex v : graph.values()) {
         v.printPath();
         System.out.println();
      }
   }
}


def digital_root (n):
    ap = 0
    n = abs(int(n))
    while n >= 10:
        n = sum(int(digit) for digit in str(n))
        ap += 1
    return ap, n

if __name__ == '__main__':
    for n in [627615, 39390, 588225, 393900588225, 55]:
        persistance, root = digital_root(n)
        print("%12i has additive persistance %2i and digital root %i."
              % (n, persistance, root))


[ abs 0 swap
  [ base share /mod
    rot + swap
    dup 0 = until ]
  drop ]                           is digitsum    ( n --> n   )

[ 0 swap
  [ dup base share > while
    dip 1+
    digitsum again ] ]             is digitalroot ( n --> n n )

[ dup digitalroot
  rot echo
  say " has additive persistance "
  swap echo
  say " and digital root of "
  echo
  say ";" cr ]                     is task        ( n -->     )

627615 task
39390 task
588225 task
393900588225 task


y=1
digital_root=function(n){
  x=sum(as.numeric(unlist(strsplit(as.character(n),""))))
  if(x<10){
    k=x
  }else{
    y=y+1
    assign("y",y,envir = globalenv())
    k=digital_root(x)
  }
  return(k)
}
print("Given number has additive persistence",y)


const dijkstra = (edges,source,target) => {
    const Q = new Set(),
          prev = {},
          dist = {},
          adj = {}

    const vertex_with_min_dist = (Q,dist) => {
        let min_distance = Infinity,
            u = null

        for (let v of Q) {
            if (dist[v] < min_distance) {
                min_distance = dist[v]
                u = v
            }
        }
        return u
    }

    for (let i=0;i<edges.length;i++) {
        let v1 = edges[i][0],
            v2 = edges[i][1],
            len = edges[i][2]

        Q.add(v1)
        Q.add(v2)

        dist[v1] = Infinity
        dist[v2] = Infinity

        if (adj[v1] === undefined) adj[v1] = {}
        if (adj[v2] === undefined) adj[v2] = {}

        adj[v1][v2] = len
        adj[v2][v1] = len
    }

    dist[source] = 0

    while (Q.size) {
        let u = vertex_with_min_dist(Q,dist),
            neighbors = Object.keys(adj[u]).filter(v=>Q.has(v)) //Neighbor still in Q

        Q.delete(u)

        if (u===target) break //Break when the target has been found

        for (let v of neighbors) {
            let alt = dist[u] + adj[u][v]
            if (alt < dist[v]) {
                dist[v] = alt
                prev[v] = u
            }
        }
    }

    {
        let u = target,
        S = [u],
        len = 0

        while (prev[u] !== undefined) {
            S.unshift(prev[u])
            len += adj[u][prev[u]]
            u = prev[u]
        }
        return [S,len]
    }
}

//Testing algorithm
let graph = []
graph.push(["a", "b", 7])
graph.push(["a", "c", 9])
graph.push(["a", "f", 14])
graph.push(["b", "c", 10])
graph.push(["b", "d", 15])
graph.push(["c", "d", 11])
graph.push(["c", "f", 2])
graph.push(["d", "e", 6])
graph.push(["e", "f", 9])

let [path,length] = dijkstra(graph, "a", "e");
console.log(path) //[ 'a', 'c', 'f', 'e' ]
console.log(length) //20


#lang racket
(define/contract (additive-persistence/digital-root n (ap 0))
  (->* (natural-number/c) (natural-number/c) (values natural-number/c natural-number/c))
  (define/contract (sum-digits x (acc 0))
    (->* (natural-number/c) (natural-number/c) natural-number/c)
    (if (= x 0)
        acc
        (let-values (((q r) (quotient/remainder x 10)))
          (sum-digits q (+ acc r)))))
  (if (< n 10)
      (values ap n)
      (additive-persistence/digital-root (sum-digits n) (+ ap 1))))

(module+ test
  (require rackunit)

  (for ((n (in-list '(627615 39390 588225 393900588225)))
        (ap (in-list '(2 2 2 2)))
        (dr (in-list '(9 6 3 9))))
    (call-with-values
      (lambda () (additive-persistence/digital-root n))
      (lambda (a d)
        (check-equal? a ap)
        (check-equal? d dr)
        (printf ":~a has additive persistence ~a and digital root of ~a;~%" n a d)))))


# (*) If using gojq, uncomment the following line:
# def keys_unsorted: keys;

# remove the first occurrence of $x from the input array
def rm($x):
  index($x) as $ix
  | if $ix then .[:$ix] + .[$ix+1:] else . end;

# Input: a Graph
# Output: a (possibly empty) stream of the neighbors of $node
# that are also in the array $ary
def neighbors($node; $ary:
  .[$node]
  | select(.)
  | keys_unsorted[]
  | . as $n
  | select($ary | index($n));

# Input: a Graph
def vertices:
  [keys_unsorted[], (.[] | keys_unsorted[])] | unique;

# Input: a Graph
# Output: the final version of the scratchpad
def dijkstra($startname):
  . as $graph
  | vertices as $Q
  # scratchpad: { node: { prev, dist} }
  | reduce $Q[] as $v ({};
      . + { ($v): {prev: null, dist: infinite}} )
  | .[$startname].dist = 0
  | { scratchpad: ., $Q }
  | until( .Q|length == 0;
      .scratchpad as $scratchpad
      | ( .Q | min_by($scratchpad[.].dist)) as $u
      | .Q |= rm($u)
      | .Q as $Q
      # for each neighbor v of u still in Q:
      | reduce ($graph|neighbors($u; $Q)) as $v (.;
              (.scratchpad[$u].dist + $graph[$u][$v]) as $alt
              | if $alt < .scratchpad[$v].dist
                then .scratchpad[$v].dist = $alt
                | .scratchpad[$v].prev = $u
		else . end ) )
  | .scratchpad ;

# Input: a Graph
# Output: the scratchpad
def Dijkstra($startname):
  if .[$startname] == null then "The graph does not contain start vertex \(startname)"
  else dijkstra($startname)
  end;

# Input: scratchpad, i.e. a dictionary with key:value pairs of the form:
#   node: {prev, dist}
# Output: an array, being
#   [optimal path from $node to $n, optimal distance from $node to $n]
def readout($node):
  . as $in
  | $node
  | [recurse($in[.].prev; .)]
  | [reverse, $in[$node].dist] ;

# Input: a graph
# Output: [path, value]
def Dijkstra($startname; $endname):
  Dijkstra($startname)
  | readout($endname) ;


struct Digraph{T <: Real,U}
    edges::Dict{Tuple{U,U},T}
    verts::Set{U}
end

function Digraph(edges::Vector{Tuple{U,U,T}}) where {T <: Real,U}
    vnames = Set{U}(v for edge in edges for v in edge[1:2])
    adjmat = Dict((edge[1], edge[2]) => edge[3] for edge in edges)
    return Digraph(adjmat, vnames)
end

vertices(g::Digraph) = g.verts
edges(g::Digraph)    = g.edges

neighbours(g::Digraph, v) = Set((b, c) for ((a, b), c) in edges(g) if a == v)

function dijkstrapath(g::Digraph{T,U}, source::U, dest::U) where {T, U}
    @assert source ∈ vertices(g) "$source is not a vertex in the graph"

    # Easy case
    if source == dest return [source], 0 end
    # Initialize variables
    inf  = typemax(T)
    dist = Dict(v => inf for v in vertices(g))
    prev = Dict(v => v   for v in vertices(g))
    dist[source] = 0
    Q = copy(vertices(g))
    neigh = Dict(v => neighbours(g, v) for v in vertices(g))

    # Main loop
    while !isempty(Q)
        u = reduce((x, y) -> dist[x] < dist[y] ? x : y, Q)
        pop!(Q, u)
        if dist[u] == inf || u == dest break end
        for (v, cost) in neigh[u]
            alt = dist[u] + cost
            if alt < dist[v]
                dist[v] = alt
                prev[v] = u
            end
        end
    end

    # Return path
    rst, cost = U[], dist[dest]
    if prev[dest] == dest
        return rst, cost
    else
        while dest != source
            unshift!(rst, dest)
            dest = prev[dest]
        end
        unshift!(rst, dest)
        return rst, cost
    end
end

# testgraph = [("a", "b", 1), ("b", "e", 2), ("a", "e", 4)]
testgraph = [("a", "b", 7),  ("a", "c", 9),  ("a", "f", 14), ("b", "c", 10),
             ("b", "d", 15), ("c", "d", 11), ("c", "f", 2),  ("d", "e", 6),
             ("e", "f", 9)]
g = Digraph(testgraph)
src, dst = "a", "e"
path, cost = dijkstrapath(g, src, dst)
println("Shortest path from $src to $dst: ", isempty(path) ? "no possible path" : join(path, " → "), " (cost $cost)")

# Print all possible paths
@printf("\n%4s | %3s | %s\n", "src", "dst", "path")
@printf("----------------\n")
for src in vertices(g), dst in vertices(g)
    path, cost = dijkstrapath(g, src, dst)
    @printf("%4s | %3s | %s\n", src, dst, isempty(path) ? "no possible path" : join(path, " → ") * " ($cost)")
end


c = 0
see "Digital root of 627615 is " + digitRoot(627615, 10) + " persistance is " + c + nl
see "Digital root of 39390  is " + digitRoot(39390, 10) +  " persistance is " + c + nl
see "Digital root of 588225 is " + digitRoot(588225, 10) +  " persistance is " + c + nl
see "Digital root of 9992   is " + digitRoot(9992, 10) +  " persistance is " + c + nl

func digitRoot n,b
     c = 0
     while n >= b
           c = c + 1
           n = digSum(n, b)
     end
     return n

func digSum n, b
     s = 0
     while n != 0
           q = floor(n / b)
           s = s + n - q * b
           n = q
     end
     return s


with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;

with Synchronization.Generic_Mutexes_Array;

procedure Test_Dining_Philosophers is
   type Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
   package Fork_Arrays is new Synchronization.Generic_Mutexes_Array (Philosopher);
   use Fork_Arrays;

   Life_Span : constant := 20;    -- In his life a philosopher eats 20 times
   Forks : aliased Mutexes_Array; -- Forks for hungry philosophers

   function Left_Of (Fork : Philosopher) return Philosopher is
   begin
      if Fork = Philosopher'First then
         return Philosopher'Last;
      else
         return Philosopher'Pred (Fork);
      end if;
   end Left_Of;

   task type Person (ID : Philosopher);
   task body Person is
      Cutlery : aliased Mutexes_Set := ID or Left_Of (ID);
      Dice    : Generator;
   begin
      Reset (Dice);
      for Life_Cycle in 1..Life_Span loop
         Put_Line (Philosopher'Image (ID) & " is thinking");
         delay Duration (Random (Dice) * 0.100);
         Put_Line (Philosopher'Image (ID) & " is hungry");
         declare
            Lock : Set_Holder (Forks'Access, Cutlery'Access);
         begin
            Put_Line (Philosopher'Image (ID) & " is eating");
            delay Duration (Random (Dice) * 0.100);
         end;
      end loop;
      Put_Line (Philosopher'Image (ID) & " is leaving");
   end Person;

   Ph_1 : Person (Aristotle); -- Start philosophers
   Ph_2 : Person (Kant);
   Ph_3 : Person (Spinoza);
   Ph_4 : Person (Marx);
   Ph_5 : Person (Russel);
begin
   null; -- Nothing to do in the main task, just sit and behold
end Test_Dining_Philosophers;


// version 1.1.51

import java.util.TreeSet

class Edge(val v1: String, val v2: String, val dist: Int)

 /** One vertex of the graph, complete with mappings to neighbouring vertices */
class Vertex(val name: String) : Comparable<Vertex> {

    var dist = Int.MAX_VALUE  // MAX_VALUE assumed to be infinity
    var previous: Vertex? = null
    val neighbours = HashMap<Vertex, Int>()

    fun printPath() {
        if (this == previous) {
            print(name)
        }
        else if (previous == null) {
            print("$name(unreached)")
        }
        else {
            previous!!.printPath()
            print(" -> $name($dist)")
        }
    }

    override fun compareTo(other: Vertex): Int {
        if (dist == other.dist) return name.compareTo(other.name)
        return dist.compareTo(other.dist)
    }

    override fun toString() = "($name, $dist)"
}

class Graph(
    val edges: List<Edge>,
    val directed: Boolean,
    val showAllPaths: Boolean = false
) {
    // mapping of vertex names to Vertex objects, built from a set of Edges
    private val graph = HashMap<String, Vertex>(edges.size)

    init {
        // one pass to find all vertices
        for (e in edges) {
            if (!graph.containsKey(e.v1)) graph.put(e.v1, Vertex(e.v1))
            if (!graph.containsKey(e.v2)) graph.put(e.v2, Vertex(e.v2))
        }

        // another pass to set neighbouring vertices
        for (e in edges) {
            graph[e.v1]!!.neighbours.put(graph[e.v2]!!, e.dist)
            // also do this for an undirected graph if applicable
            if (!directed) graph[e.v2]!!.neighbours.put(graph[e.v1]!!, e.dist)
        }
    }

    /** Runs dijkstra using a specified source vertex */
    fun dijkstra(startName: String) {
        if (!graph.containsKey(startName)) {
            println("Graph doesn't contain start vertex '$startName'")
            return
        }
        val source = graph[startName]
        val q = TreeSet<Vertex>()

        // set-up vertices
        for (v in graph.values) {
            v.previous = if (v == source) source else null
            v.dist = if (v == source)  0 else Int.MAX_VALUE
            q.add(v)
        }

        dijkstra(q)
    }

    /** Implementation of dijkstra's algorithm using a binary heap */
    private fun dijkstra(q: TreeSet<Vertex>) {
        while (!q.isEmpty()) {
            // vertex with shortest distance (first iteration will return source)
            val u = q.pollFirst()
            // if distance is infinite we can ignore 'u' (and any other remaining vertices)
            // since they are unreachable
            if (u.dist == Int.MAX_VALUE) break

            //look at distances to each neighbour
            for (a in u.neighbours) {
                val v = a.key // the neighbour in this iteration

                val alternateDist = u.dist + a.value
                if (alternateDist < v.dist) { // shorter path to neighbour found
                    q.remove(v)
                    v.dist = alternateDist
                    v.previous = u
                    q.add(v)
                }
            }
        }
    }

    /** Prints a path from the source to the specified vertex */
    fun printPath(endName: String) {
        if (!graph.containsKey(endName)) {
            println("Graph doesn't contain end vertex '$endName'")
            return
        }
        print(if (directed) "Directed   : " else "Undirected : ")
        graph[endName]!!.printPath()
        println()
        if (showAllPaths) printAllPaths() else println()
    }

    /** Prints the path from the source to every vertex (output order is not guaranteed) */
    private fun printAllPaths() {
        for (v in graph.values) {
            v.printPath()
            println()
        }
        println()
    }
}

val GRAPH = listOf(
    Edge("a", "b", 7),
    Edge("a", "c", 9),
    Edge("a", "f", 14),
    Edge("b", "c", 10),
    Edge("b", "d", 15),
    Edge("c", "d", 11),
    Edge("c", "f", 2),
    Edge("d", "e", 6),
    Edge("e", "f", 9)
)

const val START = "a"
const val END = "e"

fun main(args: Array<String>) {
    with (Graph(GRAPH, true)) {   // directed
        dijkstra(START)
        printPath(END)
    }
    with (Graph(GRAPH, false)) {  // undirected
        dijkstra(START)
        printPath(END)
    }
}


class String
  def digroot_persistence(base=10)
    num = self.to_i(base)
    persistence = 0
    until num < base do
      num = num.digits(base).sum
      persistence += 1
    end
    [num.to_s(base), persistence]
  end
end

puts "--- Examples in 10-Base ---"
%w(627615 39390 588225 393900588225).each do |str|
  puts "%12s has a digital root of %s and a persistence of %s." % [str, *str.digroot_persistence]
end
puts "\n--- Examples in other Base ---"
format = "%s base %s has a digital root of %s and a persistence of %s."
[["101101110110110010011011111110011000001", 2],
 [ "5BB64DFCC1", 16],
 ["5", 8],
 ["50YE8N29", 36]].each do |(str, base)|
   puts format % [str, base, *str.digroot_persistence(base)]
end


print "Digital root of 627615       is "; digitRoot$(627615, 10)
print "Digital root of 39390        is "; digitRoot$(39390, 10)
print "Digital root of 588225       is "; digitRoot$(588225, 10)
print "Digital root of 393900588225 is "; digitRoot$(393900588225, 10)
print "Digital root of 9992         is "; digitRoot$(9992, 10)
END

function digitRoot$(n,b)
WHILE n >= b
  c = c + 1
  n = digSum(n, b)
wend
digitRoot$ = n;" persistance is ";c
end function

function digSum(n, b)
WHILE n <> 0
  q = INT(n / b)
  s = s + n - q * b
  n = q
wend
digSum = s
end function


#Persistent
SetWorkingDir, %A_ScriptDir%
FileDelete, output.txt
EnoughForks := 2 ; required forks to begin eating
Fork1 := Fork2 := Fork3 := Fork4 := Fork5 := 1 ; fork supply per philosopher
SetTimer, AristotleWaitForLeftFork
SetTimer, KantWaitForLeftFork
SetTimer, SpinozaWaitForLeftFork
SetTimer, MarxWaitForLeftFork
SetTimer, RussellWaitForLeftFork
Return ;---------------------------------------------------------------

AristotleWaitForLeftFork:
	WaitForFork("Aristotle", "left", Fork1, Fork2, AristotleLeftForkCount, AristotleRightForkCount, AristotleWaitCount, EnoughForks)
Return
AristotleWaitForRightFork:
	WaitForFork("Aristotle", "right", Fork2, Fork1, AristotleRightForkCount, AristotleLeftForkCount, AristotleWaitCount, EnoughForks)
Return
AristotleFinishEating:
	ReturnForks("Aristotle", Fork1, Fork2, AristotleLeftForkCount, AristotleRightForkCount, EnoughForks)
Return

KantWaitForLeftFork:
	WaitForFork("Kant", "left", Fork2, Fork3, KantLeftForkCount, KantRightForkCount, KantWaitCount, EnoughForks)
Return
KantWaitForRightFork:
	WaitForFork("Kant", "right", Fork3, Fork2, KantRightForkCount, KantLeftForkCount, KantWaitCount, EnoughForks)
Return
KantFinishEating:
	ReturnForks("Kant", Fork2, Fork3, KantLeftForkCount, KantRightForkCount, EnoughForks)
Return

SpinozaWaitForLeftFork:
	WaitForFork("Spinoza", "left", Fork3, Fork4, SpinozaLeftForkCount, SpinozaRightForkCount, SpinozaWaitCount, EnoughForks)
Return
SpinozaWaitForRightFork:
	WaitForFork("Spinoza", "right", Fork4, Fork3, SpinozaRightForkCount, SpinozaLeftForkCount, SpinozaWaitCount, EnoughForks)
Return
SpinozaFinishEating:
	ReturnForks("Spinoza", Fork3, Fork4, SpinozaLeftForkCount, SpinozaRightForkCount, EnoughForks)
Return

MarxWaitForLeftFork:
	WaitForFork("Marx", "left", Fork4, Fork5, MarxLeftForkCount, MarxRightForkCount, MarxWaitCount, EnoughForks)
Return
MarxWaitForRightFork:
	WaitForFork("Marx", "right", Fork5, Fork4, MarxRightForkCount, MarxLeftForkCount, MarxWaitCount, EnoughForks)
Return
MarxFinishEating:
	ReturnForks("Marx", Fork4, Fork5, MarxLeftForkCount, MarxRightForkCount, EnoughForks)
Return

RussellWaitForLeftFork:
	WaitForFork("Russell", "left", Fork5, Fork1, RussellLeftForkCount, RussellRightForkCount, RussellWaitCount, EnoughForks)
Return
RussellWaitForRightFork:
	WaitForFork("Russell", "right", Fork1, Fork5, RussellRightForkCount, RussellLeftForkCount, RussellWaitCount, EnoughForks)
Return
RussellFinishEating:
	ReturnForks("Russell", Fork5, Fork1, RussellLeftForkCount, RussellRightForkCount, EnoughForks)
Return

ReturnForks(Philosopher, ByRef ThisFork, ByRef OtherFork, ByRef CurrentThisForkCount, ByRef CurrentOtherForkCount, EnoughForks) {
	OutputDebug, %Philosopher% finishes eating.
	FileAppend, %Philosopher% finishes eating.`n,output.txt
	ThisFork += CurrentThisForkCount ; return this fork
	OtherFork += CurrentOtherForkCount ; return other fork
	CurrentThisForkCount := 0 ; release this fork
	CurrentOtherForkCount := 0 ; release other fork
	OutputDebug, %Philosopher% returns all forks.
	FileAppend, %Philosopher% returns all forks.`n,output.txt

	; do something while resting

	Random, Rand, 0, 1
	Rand := Rand ? "Left" : "Right"
	SetTimer, %Philosopher%WaitFor%Rand%Fork
}

WaitForFork(Philosopher, This, ByRef ThisFork, ByRef OtherFork, ByRef CurrentThisForkCount, ByRef CurrentOtherForkCount, ByRef CurrentWaitCount, EnoughForks) {
	If This not in Left,Right
		Return Error
	Other := (This="right") ? "left" : "right"
	OutputDebug, %Philosopher% is hungry.
	FileAppend, %Philosopher% is hungry.`n,output.txt
	If (ThisFork) ; if this fork available
	{
		SetTimer, %Philosopher%WaitFor%This%Fork, Off
		CurrentWaitCount := 0
		ThisFork-- ; take this fork
		CurrentThisForkCount++ ; receive this fork
		OutputDebug, %Philosopher% grabs %This% fork.
		FileAppend, %Philosopher% grabs %This% fork.`n,output.txt
		If (CurrentThisForkCount + CurrentOtherForkCount = EnoughForks) ; if philosopher has enough forks
		{
			OutputDebug, %Philosopher% starts eating.
			FileAppend, %Philosopher% starts eating.`n,output.txt

			; do something while eating

			SetTimer, %Philosopher%FinishEating, -250
		}
		Else If (EnoughForks=2)
		{
			SetTimer, %Philosopher%WaitFor%Other%Fork
		}
		Else
		{
			Random, Rand, 0, 1
			Rand := Rand ? "Left" : "Right"
			SetTimer, %Philosopher%WaitFor%Rand%Fork
		}
	}
	Else If (CurrentOtherForkCount and CurrentWaitCount > 5) ; if we've been holding other fork too long
	{
		SetTimer, %Philosopher%WaitFor%This%Fork, Off
		CurrentWaitCount := 0
		OtherFork++ ; return other fork
		CurrentOtherForkCount-- ; release other fork
		OutputDebug, %Philosopher% drops %Other% fork.
		FileAppend, %Philosopher% drops %Other% fork.`n,output.txt
		Random, Rand, 0, 1
		Rand := Rand ? "Left" : "Right"
		SetTimer, %Philosopher%WaitFor%Rand%Fork
	}
	Else If (CurrentThisForkCount and CurrentWaitCount > 5) ; if we've been holding one of this fork too long
	{
		SetTimer, %Philosopher%WaitFor%This%Fork, Off
		CurrentWaitCount := 0
		ThisFork++ ; return other fork
		CurrentThisForkCount-- ; release other fork
		OutputDebug, %Philosopher% drops %This% fork.
		FileAppend, %Philosopher% drops %This% fork.`n,output.txt
		Random, Rand, 0, 1
		Rand := Rand ? "Left" : "Right"
		SetTimer, %Philosopher%WaitFor%Rand%Fork
	}
	Else
	{
		CurrentWaitCount++
	}
}


-- Graph definition
local edges = {
    a = {b = 7, c = 9, f = 14},
    b = {c = 10, d = 15},
    c = {d = 11, f = 2},
    d = {e = 6},
    e = {f = 9}
}

-- Fill in paths in the opposite direction to the stated edges
function complete (graph)
    for node, edges in pairs(graph) do
        for edge, distance in pairs(edges) do
            if not graph[edge] then graph[edge] = {} end
            graph[edge][node] = distance
        end
    end
end

-- Create path string from table of previous nodes
function follow (trail, destination)
    local path, nextStep = destination, trail[destination]
    while nextStep do
        path = nextStep .. " " .. path
        nextStep = trail[nextStep]
    end
    return path
end

-- Find the shortest path between the current and destination nodes
function dijkstra (graph, current, destination, directed)
    if not directed then complete(graph) end
    local unvisited, distanceTo, trail = {}, {}, {}
    local nearest, nextNode, tentative
    for node, edgeDists in pairs(graph) do
        if node == current then
            distanceTo[node] = 0
            trail[current] = false
        else
            distanceTo[node] = math.huge
            unvisited[node] = true
        end
    end
    repeat
        nearest = math.huge
        for neighbour, pathDist in pairs(graph[current]) do
            if unvisited[neighbour] then
                tentative = distanceTo[current] + pathDist
                if tentative < distanceTo[neighbour] then
                    distanceTo[neighbour] = tentative
                    trail[neighbour] = current
                end
                if tentative < nearest then
                    nearest = tentative
                    nextNode = neighbour
                end
            end
        end
        unvisited[current] = false
        current = nextNode
    until unvisited[destination] == false or nearest == math.huge
    return distanceTo[destination], follow(trail, destination)
end

-- Main procedure
print("Directed:", dijkstra(edges, "a", "e", true))
print("Undirected:", dijkstra(edges, "a", "e", false))


fn sum_digits(mut n: u64, base: u64) -> u64 {
    let mut sum = 0u64;
    while n > 0 {
        sum = sum + (n % base);
        n = n / base;
    }
    sum
}

// Returns tuple of (additive-persistence, digital-root)
fn digital_root(mut num: u64, base: u64) -> (u64, u64) {
    let mut pers = 0;
    while num >= base {
        pers = pers + 1;
        num = sum_digits(num, base);
    }
    (pers, num)
}

fn main() {

    // Test base 10
    let values = [627615u64, 39390u64, 588225u64, 393900588225u64];
    for &value in values.iter() {
        let (pers, root) = digital_root(value, 10);
        println!("{} has digital root {} and additive persistance {}",
                 value,
                 root,
                 pers);
    }

    println!("");

    // Test base 16
    let values_base16 = [0x7e0, 0x14e344, 0xd60141, 0x12343210];
    for &value in values_base16.iter() {
        let (pers, root) = digital_root(value, 16);
        println!("0x{:x} has digital root 0x{:x} and additive persistance 0x{:x}",
                 value,
                 root,
                 pers);
    }
}


def digitalRoot(x:BigInt, base:Int=10):(Int,Int) = {
  def sumDigits(x:BigInt):Int=x.toString(base) map (_.asDigit) sum
  def loop(s:Int, c:Int):(Int,Int)=if (s < 10) (s, c) else loop(sumDigits(s), c+1)
  loop(sumDigits(x), 1)
}

Seq[BigInt](627615, 39390, 588225, BigInt("393900588225")) foreach {x =>
  var (s, c)=digitalRoot(x)
  println("%d has additive persistance %d and digital root of %d".format(x,c,s))
}
var (s, c)=digitalRoot(0x7e0, 16)
println("%x has additive persistance %d and digital root of %d".format(0x7e0,c,s))


; Convert an integer into a list of its digits.

(define integer->list
  (lambda (integer)
    (let loop ((list '()) (int integer))
      (if (< int 10)
        (cons int list)
        (loop (cons (remainder int 10) list) (quotient int 10))))))

; Return the sum of the digits of an integer.

(define integer-sum-digits
  (lambda (integer)
    (fold-left + 0 (integer->list integer))))

; Compute the digital root (additive) and additive persistence of an integer.
; Return as a cons of (adr . ap).

(define adr-ap
  (lambda (integer)
    (let loop ((int integer) (cnt 0))
      (if (< int 10)
        (cons int cnt)
        (loop (integer-sum-digits int) (1+ cnt))))))

; Emit a table of integer, digital root (additive), and additive persistence
; for the example integers given.

(printf "[email protected] [email protected] [email protected]~%" "Integer" "Root" "Pers.")
(let rowloop ((intlist '(627615 39390 588225 393900588225 0 1 68010887038)))
  (when (pair? intlist)
    (let* ((int (car intlist))
           (aa (adr-ap int)))
      (printf "[email protected] [email protected] [email protected]~%" int (car aa) (cdr aa))
      (rowloop (cdr intlist)))))


      INSTALL @lib$+"TIMERLIB"

      nSeats% = 5
      DIM Name$(nSeats%-1), Fork%(nSeats%-1), tID%(nSeats%-1), Leftie%(nSeats%-1)

      Name$() = "Aristotle", "Kant", "Spinoza", "Marx", "Russell"
      Fork%() = TRUE : REM All forks are initially on the table
      Leftie%(RND(nSeats%)-1) = TRUE : REM One philosopher is lefthanded

      tID%(0) = FN_ontimer(10, PROCphilosopher0, 1)
      tID%(1) = FN_ontimer(10, PROCphilosopher1, 1)
      tID%(2) = FN_ontimer(10, PROCphilosopher2, 1)
      tID%(3) = FN_ontimer(10, PROCphilosopher3, 1)
      tID%(4) = FN_ontimer(10, PROCphilosopher4, 1)

      ON CLOSE PROCcleanup : QUIT
      ON ERROR PRINT REPORT$ : PROCcleanup : END

      DEF PROCphilosopher0 : PROCtask(0) : ENDPROC
      DEF PROCphilosopher1 : PROCtask(1) : ENDPROC
      DEF PROCphilosopher2 : PROCtask(2) : ENDPROC
      DEF PROCphilosopher3 : PROCtask(3) : ENDPROC
      DEF PROCphilosopher4 : PROCtask(4) : ENDPROC

      REPEAT
        WAIT 0
      UNTIL FALSE
      END

      DEF PROCtask(n%)
      PRIVATE state%(), lh%(), rh%()
      DIM state%(nSeats%-1), lh%(nSeats%-1), rh%(nSeats%-1)
      REM States: 0 = waiting for forks, > 0 = eating, < 0 = left the room
      CASE TRUE OF
        WHEN state%(n%) < 0:
          state%(n%) += 1 : REM Waiting to get hungry again
          IF state%(n%) = 0 PRINT Name$(n%) " is hungry again"
        WHEN state%(n%) > 0:
          state%(n%) -= 1 : REM Eating
          IF state%(n%) = 0 THEN
            SWAP Fork%((n%-1+nSeats%) MOD nSeats%), lh%(n%)
            SWAP Fork%((n% + 1) MOD nSeats%), rh%(n%)
            state%(n%) = -RND(100)
            PRINT Name$(n%) " is leaving the room"
          ENDIF
        WHEN state%(n%) = 0:
          IF Leftie%(n%) THEN
            IF NOT lh%(n%) SWAP Fork%((n%-1+nSeats%) MOD nSeats%), lh%(n%)
            IF lh%(n%) IF NOT rh%(n%) SWAP Fork%((n% + 1) MOD nSeats%), rh%(n%)
          ELSE
            IF NOT rh%(n%) SWAP Fork%((n% + 1) MOD nSeats%), rh%(n%)
            IF rh%(n%) IF NOT lh%(n%) SWAP Fork%((n%-1+nSeats%) MOD nSeats%), lh%(n%)
          ENDIF
          IF lh%(n%) AND rh%(n%) THEN
            state%(n%) = RND(100)
            PRINT Name$(n%) " is eating (" ; state%(n%) " ticks)"
          ENDIF
      ENDCASE
      ENDPROC

      DEF PROCcleanup
      LOCAL I%
      FOR I% = 0 TO nSeats%-1
        PROC_killtimer(tID%(I%))
      NEXT
      ENDPROC


#include <pthread.h>
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <stdarg.h>

#define N 5
const char *names[N] = { "Aristotle", "Kant", "Spinoza", "Marx", "Russell" };
pthread_mutex_t forks[N];

#define M 5 /* think bubbles */
const char *topic[M] = { "Spaghetti!", "Life", "Universe", "Everything", "Bathroom" };

#define lock pthread_mutex_lock
#define unlock pthread_mutex_unlock
#define xy(x, y) printf("\033[%d;%dH", x, y)
#define clear_eol(x) print(x, 12, "\033[K")
void print(int y, int x, const char *fmt, ...)
{
	static pthread_mutex_t screen = PTHREAD_MUTEX_INITIALIZER;
	va_list ap;
	va_start(ap, fmt);

	lock(&screen);
	xy(y + 1, x), vprintf(fmt, ap);
	xy(N + 1, 1), fflush(stdout);
	unlock(&screen);
}

void eat(int id)
{
	int f[2], ration, i; /* forks */
	f[0] = f[1] = id;

	/* make some (but not all) philosophers leftie.
	   could have been f[!id] = (id + 1) %N; for example */
	f[id & 1] = (id + 1) % N;

	clear_eol(id);
	print(id, 12, "..oO (forks, need forks)");

	for (i = 0; i < 2; i++) {
		lock(forks + f[i]);
		if (!i) clear_eol(id);

		print(id, 12 + (f[i] != id) * 6, "fork%d", f[i]);
		/* delay 1 sec to clearly show the order of fork acquisition */
		sleep(1);
	}

	for (i = 0, ration = 3 + rand() % 8; i < ration; i++)
		print(id, 24 + i * 4, "nom"), sleep(1);

	/* done nomming, give up forks (order doesn't matter) */
	for (i = 0; i < 2; i++) unlock(forks + f[i]);
}

void think(int id)
{
	int i, t;
	char buf[64] = {0};

	do {
		clear_eol(id);
		sprintf(buf, "..oO (%s)", topic[t = rand() % M]);

		for (i = 0; buf[i]; i++) {
			print(id, i+12, "%c", buf[i]);
			if (i < 5) usleep(200000);
		}
		usleep(500000 + rand() % 1000000);
	} while (t);
}

void* philosophize(void *a)
{
	int id = *(int*)a;
	print(id, 1, "%10s", names[id]);
	while(1) think(id), eat(id);
}

int main()
{
	int i, id[N];
	pthread_t tid[N];

	for (i = 0; i < N; i++)
		pthread_mutex_init(forks + (id[i] = i), 0);

	for (i = 0; i < N; i++)
		pthread_create(tid + i, 0, philosophize, id + i);

	/* wait forever: the threads don't actually stop */
	return pthread_join(tid[0], 0);
}


Module Dijkstra`s_algorithm {
	const max_number=1.E+306
	GetArr=lambda (n, val)->{
		dim d(n)=val
		=d()
	}
	term=("",0)
	Edges=(("a", ("b",7),("c",9),("f",14)),("b",("c",10),("d",15)),("c",("d",11),("f",2)),("d",("e",6)),("e",("f", 9)),("f",term))
	Document Doc$="Graph:"+{
	}
	ShowGraph()
	Doc$="Paths"+{
	}
	Print "Paths"
	For from_here=0 to 5
		pa=GetArr(len(Edges), -1)
		d=GetArr(len(Edges), max_number)
		Inventory S=1,2,3,4,5,6
		return d, from_here:=0
		RemoveMin=Lambda S, d, max_number-> {
			ss=each(S)
			min=max_number
			p=0
			while ss
				val=d#val(eval(S,ss^)-1)
				if min>val then let min=val : p=ss^
			end while
			=s(p!)  ' use p as index not key
			Delete S, eval(s,p)
		}
		Show_Distance_and_Path$=lambda$ d, pa, from_here, max_number (n) -> {
			ret1$=chr$(from_here+asc("a"))+" to "+chr$(n+asc("a"))
			if d#val(n) =max_number then =ret1$+ "     No Path" :exit
			let ret$="", mm=n, m=n
			repeat
				n=m
				ret$+=chr$(asc("a")+n)
				m=pa#val(n)
			until  from_here=n
			=ret1$+format$("{0::-4} {1}",d#val(mm),strrev$(ret$))
		}
		while len(s)>0
			u=RemoveMin()
			rem Print u, chr$(u-1+asc("a"))
			Relaxed()
		end while
		For i=0 to len(d)-1
			line$=Show_Distance_and_Path$(i)
			Print line$
			doc$=line$+{
			}
		next
	next
	Clipboard Doc$
	End
	Sub Relaxed()
		local vertex=Edges#val(u-1), i
		local e=Len(vertex)-1, edge=(,), val
		for i=1 to e
			edge=vertex#val(i)
			if edge#val$(0)<>"" then
				val=Asc(edge#val$(0))-Asc("a")
				if d#val(val)>edge#val(1)+d#val(u-1) then  return d, val:=edge#val(1)+d#val(u-1) : Return Pa, val:=u-1
			end if
		next
	end sub
	Sub ShowGraph()
		Print "Graph"
		local i
		for i=1 to len(Edges)
			show_edges(i)
		next
	end sub
	Sub show_edges(n)
		n--
		local vertex=Edges#val(n), line$
		local e=each(vertex 2 to end), v2=(,)
		While e
			v2=array(e)
			line$=vertex#val$(0)+if$(v2#val$(0)<>""->"->"+v2#val$(0)+format$(" {0::-2}",v2#val(1)),"")
			Print line$
			Doc$=line$+{
			}
		end while
	end sub
}
Dijkstra`s_algorithm


$ include "seed7_05.s7i";
  include "bigint.s7i";

const func bigInteger: digitalRoot (in var bigInteger: num, in bigInteger: base, inout bigInteger: persistence) is func
  result
     var bigInteger: sum is 0_;
  begin
    persistence := 0_;
    while num >= base do
      sum := 0_;
      while num > 0_ do
        sum +:= num rem base;
        num := num div base;
      end while;
      num := sum;
      incr(persistence);
    end while;
  end func;

const proc: main is func
  local
    var bigInteger: num is 0_;
    var bigInteger: root is 0_;
    var bigInteger: persistence is 0_;
  begin
    for num range [] (627615_, 39390_, 588225_, 393900588225_) do
      root := digitalRoot(num, 10_, persistence);
      writeln(num <& " has additive persistence " <& persistence <& " and digital root of " <& root);
    end for;
  end func;


func digroot (r, base = 10) {
    var root = r.base(base)
    var persistence = 0
    while (root.len > 1) {
        root = root.chars.map{|n| Number(n, 36) }.sum(0).base(base)
        ++persistence
    }
    return(persistence, root)
}

var nums = [5, 627615, 39390, 588225, 393900588225]
var bases = [2, 3, 8, 10, 16, 36]
var fmt = "%25s(%2s): persistance = %s, root = %2s\n"

nums << (550777011503 *
         105564897893993412813307040538786690718089963180462913406682192479)

bases.each { |b|
    nums.each { |n|
        var x = n.base(b)
        x = 'BIG' if (x.len > 25)
        fmt.printf(x, b, digroot(n, b))
    }
    print "\n"
}


digitalRoot :=
  [:nr :arIn |
    r := (nr printString asArray collect:#digitValue) sum.
    r > 9 ifTrue:[
       digitalRoot value:r value:arIn+1.
    ] ifFalse:[
       { arIn+1 .  r }
    ].
  ].

#(
   627615 39390 588225 393900588225 10 199
   1999999999999999999999999999999999999999999999999999999999999999999999999999999999999
) do:[:nr |
   Transcript showCR:'%1 has digitalRoot %3 and Additive Resistance %2'
              withArguments:{nr},(digitalRoot value:nr value:0)
]


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading;
using System.Threading.Tasks;

namespace Dining_Philosophers
{
    class Program
    {
        private const int DinerCount = 5;
        private static List<Diner> Diners = new List<Diner>();
        private static List<Fork> Forks = new List<Fork>();
        private static DateTime TimeToStop;

        static void Main(string[] args)
        {
            Initialize();
            WriteHeaderLine();

            do
            {
                WriteStatusLine();
                Thread.Sleep(1000);
            }
            while (DateTime.Now < TimeToStop);

            TearDown();
        }

        private static void Initialize()
        {
            for (int i = 0; i < DinerCount; i++)
                Forks.Add(new Fork());
            for (int i = 0; i < DinerCount; i++)
                Diners.Add(new Diner(i, Forks[i], Forks[(i + 1) % DinerCount]));

            TimeToStop = DateTime.Now.AddSeconds(60);
        }

        private static void TearDown()
        {
            foreach (var diner in Diners)
                diner.Dispose();
        }

        private static void WriteHeaderLine()
        {
            Console.Write("|");

            foreach (Diner d in Diners)
                Console.Write("D " + d.ID + "|");

            Console.Write("    |");

            for (int i = 0; i < DinerCount; i++)
                Console.Write("F" + i + "|");

            Console.WriteLine();
        }

        private static void WriteStatusLine()
        {
            Console.Write("|");

            foreach (Diner d in Diners)
                Console.Write(FormatDinerState(d) + "|");

            Console.Write("    |");

            foreach (Fork f in Forks)
                Console.Write(FormatForkState(f) + "|");

            Console.WriteLine();
        }

        private static string FormatDinerState(Diner diner)
        {
            switch (diner.State)
            {
                case Diner.DinerState.Eating:
                    return "Eat";
                case Diner.DinerState.Pondering:
                    return "Pon";
                case Diner.DinerState.TryingToGetForks:
                    return "Get";
                default:
                    throw new Exception("Unknown diner state.");
            }
        }

        private static string FormatForkState(Fork fork)
        {
            return (!ForkIsBeingUsed(fork) ? "  " : "D" + GetForkHolder(fork));
        }

        private static bool ForkIsBeingUsed(Fork fork)
        {
            return Diners.Count(d => d.CurrentlyHeldForks.Contains(fork)) > 0;
        }

        private static int GetForkHolder(Fork fork)
        {
            return Diners.Single(d => d.CurrentlyHeldForks.Contains(fork)).ID;
        }
    }

    class Diner : IDisposable
    {
        private bool IsCurrentlyHoldingLeftFork = false;
        private bool IsCurrentlyHoldingRightFork = false;
        private const int MaximumWaitTime = 100;
        private static Random Randomizer = new Random();
        private bool ShouldStopEating = false;

        public int ID { get; private set; }
        public Fork LeftFork { get; private set; }
        public Fork RightFork { get; private set; }
        public DinerState State { get; private set; }

        public IEnumerable<Fork> CurrentlyHeldForks
        {
            get
            {
                var forks = new List<Fork>();
                if (IsCurrentlyHoldingLeftFork)
                    forks.Add(LeftFork);
                if (IsCurrentlyHoldingRightFork)
                    forks.Add(RightFork);
                return forks;
            }
        }

        public Diner(int id, Fork leftFork, Fork rightFork)
        {
            InitializeDinerState(id, leftFork, rightFork);
            BeginDinerActivity();
        }

        private void KeepTryingToEat()
        {
            do
                if (State == DinerState.TryingToGetForks)
                {
                    TryToGetLeftFork();
                    if (IsCurrentlyHoldingLeftFork)
                    {
                        TryToGetRightFork();
                        if (IsCurrentlyHoldingRightFork)
                        {
                            Eat();
                            DropForks();
                            Ponder();
                        }
                        else
                        {
                            DropForks();
                            WaitForAMoment();
                        }
                    }
                    else
                        WaitForAMoment();
                }
                else
                    State = DinerState.TryingToGetForks;
            while (!ShouldStopEating);
        }

        private void InitializeDinerState(int id, Fork leftFork, Fork rightFork)
        {
            ID = id;
            LeftFork = leftFork;
            RightFork = rightFork;
            State = DinerState.TryingToGetForks;
        }

        private async void BeginDinerActivity()
        {
            await Task.Run(() => KeepTryingToEat());
        }

        private void TryToGetLeftFork()
        {
            Monitor.TryEnter(LeftFork, ref IsCurrentlyHoldingLeftFork);
        }

        private void TryToGetRightFork()
        {
            Monitor.TryEnter(RightFork, ref IsCurrentlyHoldingRightFork);
        }

        private void DropForks()
        {
            DropLeftFork();
            DropRightFork();
        }

        private void DropLeftFork()
        {
            if (IsCurrentlyHoldingLeftFork)
            {
                IsCurrentlyHoldingLeftFork = false;
                Monitor.Exit(LeftFork);
            }
        }

        private void DropRightFork()
        {
            if (IsCurrentlyHoldingRightFork)
            {
                IsCurrentlyHoldingRightFork = false;
                Monitor.Exit(RightFork);
            }
        }

        private void Eat()
        {
            State = DinerState.Eating;
            WaitForAMoment();
        }

        private void Ponder()
        {
            State = DinerState.Pondering;
            WaitForAMoment();
        }

        private static void WaitForAMoment()
        {
            Thread.Sleep(Randomizer.Next(MaximumWaitTime));
        }

        public void Dispose()
        {
            ShouldStopEating = true;
        }

        public enum DinerState
        {
            Eating,
            TryingToGetForks,
            Pondering
        }
    }

    class Fork { }
}


bd = Graph[{"a" \[DirectedEdge] "b", "a" \[DirectedEdge] "c",
   "b" \[DirectedEdge] "c", "b" \[DirectedEdge] "d",
   "c" \[DirectedEdge] "d", "d" \[DirectedEdge] "e",
   "a" \[DirectedEdge] "f", "c" \[DirectedEdge] "f",
   "e" \[DirectedEdge] "f"},
  EdgeWeight -> {7, 9, 10, 15, 11, 6, 14, 2, 9},
  VertexLabels -> "Name", VertexLabelStyle -> Directive[Black, 20],
  ImagePadding -> 20]

FindShortestPath[bd, "a", "e", Method -> "Dijkstra"]
-> {"a", "c", "d", "e"}


DEF DIGITAL_ROOT N OUT DR,AP
 AP=0
 DR=N
 WHILE DR>9
  INC AP
  STRDR$=STR$(DR)
  NEWDR=0
  FOR I=0 TO LEN(STRDR$)-1
   INC NEWDR,VAL(MID$(STRDR$,I,1))
  NEXT
  DR=NEWDR
 WEND
END


package require Tcl 8.5
proc digitalroot num {
    for {set p 0} {[string length $num] > 1} {incr p} {
	set num [::tcl::mathop::+ {*}[split $num ""]]
    }
    list $p $num
}

foreach n {627615 39390 588225 393900588225} {
    lassign [digitalroot $n] p r
    puts [format "$n has additive persistence $p and digital root of $r"]
}


:ClrHome
:1→X
:Input ">",Str1
:Str1→Str2
:Repeat L≤1
:Disp Str1
:length(Str1→L
:L→dim(L₁
:seq(expr(sub(Str1,A,1)),A,1,L)→L₁
:sum(L₁→N
:{0,.5,1→L₂
:NL₂→L₃
:Med-Med L₂,L₃,Y₁
:Equ►String(Y₁,Str1
:sub(Str1,1,length(Str1)-3→Str1
:X+1→X
:End
:Pause
:ClrHome
:Disp Str2,"DIGITAL ROOT",expr(Str1),"ADDITIVE","PERSISTENCE",X
:Pause


#include <algorithm>
#include <array>
#include <chrono>
#include <iostream>
#include <mutex>
#include <random>
#include <string>
#include <string_view>
#include <thread>

const int timeScale = 42;  // scale factor for the philosophers task duration

void Message(std::string_view message)
{
    // thread safe printing
    static std::mutex cout_mutex;
    std::scoped_lock cout_lock(cout_mutex);
    std::cout << message << std::endl;
}

struct Fork {
    std::mutex mutex;
};

struct Dinner {
    std::array<Fork, 5> forks;
    ~Dinner() { Message("Dinner is over"); }
};

class Philosopher
{
    // generates random numbers using the Mersenne Twister algorithm
    // for task times and messages
    std::mt19937 rng{std::random_device {}()};

    const std::string name;
    Fork& left;
    Fork& right;
    std::thread worker;

    void live();
    void dine();
    void ponder();
public:
    Philosopher(std::string name_, Fork& l, Fork& r)
    : name(std::move(name_)), left(l), right(r), worker(&Philosopher::live, this)
    {}
    ~Philosopher()
    {
        worker.join();
        Message(name + " went to sleep.");
    }
};

void Philosopher::live()
{
    for(;;) // run forever
    {
        {
            //Aquire forks.  scoped_lock acquires the mutexes for
            //both forks using a deadlock avoidance algorithm
            std::scoped_lock dine_lock(left.mutex, right.mutex);

            dine();

            //The mutexes are released here at the end of the scope
        }

        ponder();
    }
}

void Philosopher::dine()
{
    Message(name + " started eating.");

    // Print some random messages while the philosopher is eating
    thread_local std::array<const char*, 3> foods {"chicken", "rice", "soda"};
    thread_local std::array<const char*, 3> reactions {
        "I like this %s!", "This %s is good.", "Mmm, %s..."
    };
    thread_local std::uniform_int_distribution<> dist(1, 6);
    std::shuffle(    foods.begin(),     foods.end(), rng);
    std::shuffle(reactions.begin(), reactions.end(), rng);

    constexpr size_t buf_size = 64;
    char buffer[buf_size];
    for(int i = 0; i < 3; ++i) {
        std::this_thread::sleep_for(std::chrono::milliseconds(dist(rng) * timeScale));
        snprintf(buffer, buf_size, reactions[i], foods[i]);
        Message(name + ": " + buffer);
    }
    std::this_thread::sleep_for(std::chrono::milliseconds(dist(rng)) * timeScale);

    Message(name + " finished and left.");
}

void Philosopher::ponder()
{
    static constexpr std::array<const char*, 5> topics {{
        "politics", "art", "meaning of life", "source of morality", "how many straws makes a bale"
    }};
    thread_local std::uniform_int_distribution<> wait(1, 6);
    thread_local std::uniform_int_distribution<> dist(0, topics.size() - 1);
    while(dist(rng) > 0) {
        std::this_thread::sleep_for(std::chrono::milliseconds(wait(rng) * 3 * timeScale));
        Message(name + " is pondering about " + topics[dist(rng)] + ".");
    }
    std::this_thread::sleep_for(std::chrono::milliseconds(wait(rng) * 3 * timeScale));
    Message(name + " is hungry again!");
}

int main()
{
    Dinner dinner;
    Message("Dinner started!");
    // The philosophers will start as soon as they are created
    std::array<Philosopher, 5> philosophers {{
            {"Aristotle",   dinner.forks[0], dinner.forks[1]},
            {"Democritus",  dinner.forks[1], dinner.forks[2]},
            {"Plato",       dinner.forks[2], dinner.forks[3]},
            {"Pythagoras",  dinner.forks[3], dinner.forks[4]},
            {"Socrates",    dinner.forks[4], dinner.forks[0]},
    }};
    Message("It is dark outside...");
}


# Dijkstra algorithm.

from algorithm import reverse
import sets
import strformat
import tables

type
  Edge = tuple[src, dst: string; cost: int]
  Graph = object
    vertices: HashSet[string]
    neighbours: Table[string, seq[tuple[dst: string, cost: float]]]

#---------------------------------------------------------------------------------------------------

proc initGraph(edges: openArray[Edge]): Graph =
  ## Initialize a graph from an edge list.
  ## Use floats for costs in order to compare to Inf value.

  for (src, dst, cost) in edges:
    result.vertices.incl(src)
    result.vertices.incl(dst)
    result.neighbours.mgetOrPut(src, @[]).add((dst, cost.toFloat))

#---------------------------------------------------------------------------------------------------

proc dijkstraPath(graph: Graph; first, last: string): seq[string] =
  ## Find the path from "first" to "last" which minimizes the cost.

  var dist = initTable[string, float]()
  var previous = initTable[string, string]()
  var notSeen = graph.vertices
  for vertex in graph.vertices:
    dist[vertex] = Inf
  dist[first] = 0

  while notSeen.card > 0:
    # Search vertex with minimal distance.
    var vertex1: string
    var mindist = Inf
    for vertex in notSeen:
      if dist[vertex] < mindist:
        vertex1 = vertex
        mindist = dist[vertex]
    if vertex1 == last:
      break
    notSeen.excl(vertex1)
    # Find shortest paths to neighbours.
    for (vertex2, cost) in graph.neighbours.getOrDefault(vertex1):
      if vertex2 in notSeen:
        let altdist = dist[vertex1] + cost
        if altdist < dist[vertex2]:
          # Found a shorter path to go to vertex2.
          dist[vertex2] = altdist
          previous[vertex2] = vertex1    # To go to vertex2, go through vertex1.

  # Build the path.
  var vertex = last
  while vertex.len > 0:
    result.add(vertex)
    vertex = previous.getOrDefault(vertex)
  result.reverse()

#---------------------------------------------------------------------------------------------------

proc printPath(path: seq[string]) =
  ## Print a path.
  stdout.write(fmt"Shortest path from '{path[0]}' to '{path[^1]}': {path[0]}")
  for i in 1..path.high:
    stdout.write(fmt" → {path[i]}")
  stdout.write('\n')

#---------------------------------------------------------------------------------------------------

let graph = initGraph([("a", "b", 7), ("a", "c", 9), ("a", "f", 14),
                       ("b", "c", 10), ("b", "d", 15), ("c", "d", 11),
                       ("c", "f", 2), ("d", "e", 6), ("e", "f", 9)])
printPath(graph.dijkstraPath("a", "e"))
printPath(graph.dijkstraPath("a", "f"))


let list_vertices graph =
  List.fold_left (fun acc ((a, b), _) ->
    let acc = if List.mem b acc then acc else b::acc in
    let acc = if List.mem a acc then acc else a::acc in
    acc
  ) [] graph

let neighbors v =
  List.fold_left (fun acc ((a, b), d) ->
    if a = v then (b, d)::acc else acc
  ) []

let remove_from v lst =
  let rec aux acc = function [] -> failwith "remove_from"
  | x::xs -> if x = v then List.rev_append acc xs else aux (x::acc) xs
  in aux [] lst

let with_smallest_distance q dist =
  match q with
  | [] -> assert false
  | x::xs ->
      let rec aux distance v = function
      | x::xs ->
          let d = Hashtbl.find dist x in
          if d < distance
          then aux d x xs
          else aux distance v xs
      | [] -> (v, distance)
      in
      aux (Hashtbl.find dist x) x xs

let dijkstra max_val zero add graph source target =
  let vertices = list_vertices graph in
  let dist_between u v =
    try List.assoc (u, v) graph
    with _ -> zero
  in
  let dist = Hashtbl.create 1 in
  let previous = Hashtbl.create 1 in
  List.iter (fun v ->                  (* initializations *)
    Hashtbl.add dist v max_val         (* unknown distance function from source to v *)
  ) vertices;
  Hashtbl.replace dist source zero;    (* distance from source to source *)
  let rec loop = function [] -> ()
  | q ->
      let u, dist_u =
        with_smallest_distance q dist in   (* vertex in q with smallest distance in dist *)
      if dist_u = max_val then
        failwith "vertices inaccessible";  (* all remaining vertices are inaccessible from source *)
      if u = target then () else begin
        let q = remove_from u q in
        List.iter (fun (v, d) ->
          if List.mem v q then begin
            let alt = add dist_u (dist_between u v) in
            let dist_v = Hashtbl.find dist v in
            if alt < dist_v then begin       (* relax (u,v,a) *)
              Hashtbl.replace dist v alt;
              Hashtbl.replace previous v u;  (* previous node in optimal path from source *)
            end
          end
        ) (neighbors u graph);
        loop q
      end
  in
  loop vertices;
  let s = ref [] in
  let u = ref target in
  while Hashtbl.mem previous !u do
    s := !u :: !s;
    u := Hashtbl.find previous !u
  done;
  (source :: !s)

let () =
  let graph =
    [ ("a", "b"), 7;
      ("a", "c"), 9;
      ("a", "f"), 14;
      ("b", "c"), 10;
      ("b", "d"), 15;
      ("c", "d"), 11;
      ("c", "f"), 2;
      ("d", "e"), 6;
      ("e", "f"), 9; ]
  in
  let p = dijkstra max_int 0 (+) graph "a" "e" in
  print_endline (String.concat " -> " p)


// Digital root

function rootAndPers(n: number, bas: number): [number, number] {
  var pers = 0;
  while (n >= bas)
  {
    var s = 0;
    do
    {
      s += n % bas;
      n = Math.floor(n / bas);
    } while (n > 0);
    pers++;
    n = s;
  }
  return [n, pers];
}

function intToString(n: number, wdth: number): string {
  sn = (Math.floor(n)).toString();
  len = sn.length;
  return (wdth < len ? "#".repeat(wdth) : " ".repeat(wdth - len) + sn);
}

for (var a of [1, 14, 267, 8128, 39390, 588225, 627615])
{
  var rp = rootAndPers(a, 10);
  console.log(intToString(a, 7) +
    intToString(rp[1], 6) + intToString(rp[0], 6));
}


PRINT "Digital root of 627615 is "; FUNC(_FNdigitalroot(627615, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"

PRINT "Digital root of 39390 is "; FUNC(_FNdigitalroot(39390, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"

PRINT "Digital root of 588225 is "; FUNC(_FNdigitalroot(588225, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"

PRINT "Digital root of 9992 is "; FUNC(_FNdigitalroot(9992, 10)) ;
PRINT " (additive persistence " ; Pop(); ")"
END

_FNdigitalroot Param(2)
  Local (1)
  [email protected] = 0
  Do Until [email protected] < [email protected]
    [email protected] = [email protected] + 1
    [email protected] = FUNC(_FNdigitsum ([email protected], [email protected]))
  Loop
  Push ([email protected])                            ' That's how uBasic handles an extra
Return ([email protected])                            ' return value: on the stack

_FNdigitsum Param (2)
  Local (2)
  [email protected] =0
  Do While [email protected] # 0
    [email protected] = [email protected] / [email protected]
    [email protected] = [email protected] + [email protected] - ([email protected] * [email protected])
    [email protected] = [email protected]
  Loop
Return ([email protected])


(defn make-fork []
  (ref true))

(defn make-philosopher [name forks food-amt]
  (ref {:name name :forks forks :eating? false :food food-amt}))

(defn start-eating [phil]
  (dosync
    (if (every? true? (map ensure (:forks @phil)))  ; <-- the essential solution
      (do
        (doseq [f (:forks @phil)] (alter f not))
        (alter phil assoc :eating? true)
        (alter phil update-in [:food] dec)
        true)
      false)))

(defn stop-eating [phil]
  (dosync
    (when (:eating? @phil)
      (alter phil assoc :eating? false)
      (doseq [f (:forks @phil)] (alter f not)))))

(defn dine [phil retry-interval max-eat-duration max-think-duration]
  (while (pos? (:food @phil))
    (if (start-eating phil)
      (do
        (Thread/sleep (rand-int max-eat-duration))
        (stop-eating phil)
        (Thread/sleep (rand-int max-think-duration)))
      (Thread/sleep retry-interval))))


shortestPath(G, startAt=1)={
	my(n=#G[,1],dist=vector(n,i,9e99),prev=dist,Q=2^n-1);
	dist[startAt]=0;
	while(Q,
		my(t=vecmin(vecextract(dist,Q)),u);
		if(t==9e99, break);
		for(i=1,#v,if(dist[i]==t && bittest(Q,i-1), u=i; break));
		Q-=1<<(u-1);
		for(i=1,n,
			if(!G[u,i],next);
			my(alt=dist[u]+G[u,i]);
			if (alt < dist[i],
				dist[i]=alt;
				prev[i]=u;
			)
		)
	);
	dist
};


#!/usr/bin/env bash

numbers=(627615 39390 588225 393900588225 55)
declare root

for number in "${numbers[@]}"; do
    declare -i iterations
    root="${number}"
    while [[ "${#root}" -ne 1 ]]; do
        root="$(( $(fold -w1 <<<"${root}" | xargs | sed 's/ /+/g') ))"
        iterations+=1
    done
    echo -e "${number} has additive persistence ${iterations} and digital root ${root}"
    unset iterations
done | column -t


Option Base 1
Private Sub digital_root(n As Variant)
    Dim s As String, t() As Integer
    s = CStr(n)
    ReDim t(Len(s))
    For i = 1 To Len(s)
        t(i) = Mid(s, i, 1)
    Next i
    Do
        dr = WorksheetFunction.Sum(t)
        s = CStr(dr)
        ReDim t(Len(s))
        For i = 1 To Len(s)
            t(i) = Mid(s, i, 1)
        Next i
        persistence = persistence + 1
    Loop Until Len(s) = 1
    Debug.Print n; "has additive persistence"; persistence; "and digital root of "; dr & ";"
End Sub
Public Sub main()
    digital_root 627615
    digital_root 39390
    digital_root 588225
    digital_root 393900588225#
End Sub


Function digital_root(n)
	ap = 0
	Do Until Len(n) = 1
		x = 0
		For i = 1 To Len(n)
			x = x + CInt(Mid(n,i,1))
		Next
		n = x
		ap = ap + 1
	Loop
	digital_root = "Additive Persistence = " & ap & vbCrLf &_
		"Digital Root = " & n & vbCrLf
End Function

WScript.StdOut.Write digital_root(WScript.Arguments(0))


(in-package :common-lisp-user)

;;
;; FLAG -- if using quicklisp, you can get bordeaux-threads loaded up
;; with: (ql:quickload :bordeaux-threads)
;;

(defvar *philosophers* '(Aristotle Kant Spinoza Marx Russell))

(defclass philosopher ()
  ((name :initarg :name :reader name-of)
   (left-fork :initarg :left-fork :accessor left-fork-of)
   (right-fork :initarg :right-fork :accessor right-fork-of)
   (meals-left :initarg :meals-left :accessor meals-left-of)))

(defclass fork ()
  ((lock :initform (bt:make-lock "fork") :reader lock-of)))

(defun random-normal (&optional (mean 0.0) (sd 1.0))
  (do* ((x1 #1=(1- (* 2.0d0 (random 1d0))) #1#)
        (x2 #2=(1- (* 2.0d0 (random 1d0))) #2#)
        (w  #3=(+ (* x1 x1) (* x2 x2)) #3#))
      ((< w 1d0) (+ (* (* x1 (sqrt (/ (* -2d0 (log w)) w))) sd) mean))))

(defun sleep* (time) (sleep (max time (/ (expt 10 7)))))

(defun dining-philosophers (&key (philosopher-names *philosophers*)
                                 (meals 30)
                                 (dining-time'(1 2))
                                 (thinking-time '(1 2))
                                 ((stream e) *error-output*))
  (let* ((count (length philosopher-names))
         (forks (loop repeat count collect (make-instance 'fork)))
         (philosophers (loop for i from 0
                             for name in philosopher-names collect
                               (make-instance 'philosopher
                                    :left-fork (nth (mod i count) forks)
                                    :right-fork (nth (mod (1+ i) count) forks)
                                    :name name
                                    :meals-left meals)))
         (condition (bt:make-condition-variable))
         (lock (bt:make-lock "main loop"))
         (output-lock (bt:make-lock "output lock")))
    (dolist (p philosophers)
      (labels ((think ()
                 (/me "is now thinking")
                 (sleep* (apply #'random-normal thinking-time))
                 (/me "is now hungry")
                 (dine))
               (dine ()
                 (bt:with-lock-held ((lock-of (left-fork-of p)))
                   (or (bt:acquire-lock (lock-of (right-fork-of p)) nil)
                       (progn (/me "couldn't get a fork and ~
                                    returns to thinking")
                              (bt:release-lock (lock-of (left-fork-of p)))
                              (return-from dine (think))))
                   (/me "is eating")
                   (sleep* (apply #'random-normal dining-time))
                   (bt:release-lock (lock-of (right-fork-of p)))
                   (/me "is done eating (~A meals left)"
                        (decf (meals-left-of p))))
                 (cond ((<= (meals-left-of p) 0)
                        (/me "leaves the dining room")
                        (bt:with-lock-held (lock)
                          (setq philosophers (delete p philosophers))
                          (bt:condition-notify condition)))
                       (t (think))))
               (/me (control &rest args)
                 (bt:with-lock-held (output-lock)
                   (write-sequence (string (name-of p)) e)
                   (write-char #\Space e)
                   (apply #'format e (concatenate 'string control "~%")
                          args))))
        (bt:make-thread #'think)))
    (loop (bt:with-lock-held (lock)
            (when (endp philosophers)
              (format e "all philosophers are done dining~%")
              (return)))
          (bt:with-lock-held (lock)
            (bt:condition-wait condition lock)))))


program dijkstra(output);

type
  { We dynamically build the list of vertices from the edge list,
    just to avoid repeating ourselves in the graph input. Vertices are linked
    together via their `next` pointers to form a list of all vertices (sorted by
    name), while the `previous` pointer indicates the previous vertex along the
    shortest path to this one. }
  vertex = record
    name: char;
    visited: boolean;
    distance: integer;
    previous: ^vertex;
    next: ^vertex;
  end;

  vptr = ^vertex;

  { The graph is specified as an array of these }
  edge_desc = record
    source: char;
    dest: char;
    weight: integer;
  end;

const
  { the input graph }
  edges:    array of edge_desc = (
    (source:'a'; dest:'b'; weight:7),
    (source:'a'; dest:'c'; weight:9),
    (source:'a'; dest:'f'; weight:14),
    (source:'b'; dest:'c'; weight:10),
    (source:'b'; dest:'d'; weight:15),
    (source:'c'; dest:'d'; weight:11),
    (source:'c'; dest:'f'; weight:2),
    (source:'d'; dest:'e'; weight:6),
    (source:'e'; dest:'f'; weight:9)
  );

  { find the shortest path to all nodes starting from this one }
  origin: char = 'a';

var
  head_vertex: vptr = nil;
  curr, next, closest: vptr;
  vtx: vptr;
  dist: integer;
  edge: edge_desc;
  done: boolean = false;

{ allocate a new vertex node with the given name and `next` pointer }
function new_vertex(key: char; next: vptr): vptr;

  var
    vtx: vptr;
  begin
    new(vtx);
    vtx^.name := key;
    vtx^.visited := false;
    vtx^.distance := maxint;
    vtx^.previous := nil;
    vtx^.next := next;
    new_vertex := vtx;
  end;

{ look up a vertex by name; create it if needed }
function find_or_make_vertex(key: char): vptr; var
    vtx, prev, found: vptr;
    done: boolean;

  begin

    found := nil;
    if head_vertex = nil then
      head_vertex := new_vertex(key, nil)
    else if head_vertex^.name > key then
      head_vertex := new_vertex(key, head_vertex);

    if head_vertex^.name = key then
      found := head_vertex
    else begin
      prev := head_vertex;
      vtx := head_vertex^.next;
      done := false;
      while not done do
        if vtx = nil then
          done := true
        else if vtx^.name >= key then
          done := true
        else begin
          prev := vtx;
          vtx := vtx^.next
        end;
      if vtx <> nil then
        if vtx^.name = key then
          found := vtx;
      if found = nil then begin
        prev^.next := new_vertex(key, vtx);
        found := prev^.next;
      end
    end;
    find_or_make_vertex := found
  end;

{ display the path to a vertex indicated by its `previous` pointer chain }
procedure write_path(vtx: vptr);
  begin
    if vtx <> nil then begin
      if vtx^.previous <> nil then begin
        write_path(vtx^.previous);
        write('→');
      end;
      write(vtx^.name);
    end;
  end;

begin
  curr := find_or_make_vertex(origin);
  curr^.distance := 0;
  curr^.previous := nil;
  while not done do begin
    for edge in edges do begin
      if edge.source = curr^.name then begin
        next := find_or_make_vertex(edge.dest);
        dist := curr^.distance + edge.weight;
        if dist < next^.distance then begin
           next^.distance := dist;
           next^.previous := curr;
        end
      end
    end;
    curr^.visited := true;
    closest := nil;
    vtx := head_vertex;
    while vtx <> nil do begin
      if not vtx^.visited then
        if closest = nil then
          closest := vtx
        else if vtx^.distance < closest^.distance then
          closest := vtx;
      vtx := vtx^.next;
    end;
    if closest = nil then
      done := true
    else if closest^.distance = maxint then
      done := true;
    curr := closest;
  end;
  writeln('Shortest path to each vertex from ', origin, ':');
  vtx := head_vertex;
  while vtx <> nil do begin
    write(vtx^.name, ':', vtx^.distance);
    if vtx^.distance > 0 then begin
      write(' (');
      write_path(vtx);
      write(')');
    end;
    writeln();
    vtx := vtx^.next;
  end
end.


Module Module1

    Function DigitalRoot(num As Long) As Tuple(Of Integer, Integer)
        Dim additivepersistence = 0
        While num > 9
            num = num.ToString().ToCharArray().Sum(Function(x) Integer.Parse(x))
            additivepersistence = additivepersistence + 1
        End While
        Return Tuple.Create(additivepersistence, CType(num, Integer))
    End Function

    Sub Main()
        Dim nums = {627615, 39390, 588225, 393900588225}
        For Each num In nums
            Dim t = DigitalRoot(num)
            Console.WriteLine("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
        Next
    End Sub

End Module


import strconv

fn sum(ii u64, base int) int {
	mut s := 0
	mut i := ii
	b64 := u64(base)
	for ; i > 0; i /= b64 {
		s += int(i % b64)
	}
	return s
}

fn digital_root(n u64, base int) (int, int) {
	mut persistence := 0
	mut root := int(n)
	for x := n; x >= u64(base); x = u64(root) {
		root = sum(x, base)
		persistence++
	}
	return persistence, root
}

// Normally the below would be moved to a *_test.go file and
// use the testing package to be runnable as a regular test.

struct Test{
	n string
	base int
	persistence int
	root int
}

const test_cases = [
	Test{"627615", 10, 2, 9},
	Test{"39390", 10, 2, 6},
	Test{"588225", 10, 2, 3},
	Test{"393900588225", 10, 2, 9},
	Test{"1", 10, 0, 1},
	Test{"11", 10, 1, 2},
	Test{"e", 16, 0, 0xe},
	Test{"87", 16, 1, 0xf},
	// From Applesoft BASIC example:
	Test{"DigitalRoot", 30, 2, 26}, // 26 is Q base 30
	// From C++ example:
	Test{"448944221089", 10, 3, 1},
	Test{"7e0", 16, 2, 0x6},
	Test{"14e344", 16, 2, 0xf},
	Test{"d60141", 16, 2, 0xa},
	Test{"12343210", 16, 2, 0x1},
	// From the D example:
	Test{"1101122201121110011000000", 3, 3, 1},
]

fn main() {
	for tc in test_cases {
		n, err := strconv.common_parse_uint2(tc.n, tc.base, 64)
		if err != 0 {
			panic('ERROR')
		}
		p, r := digital_root(n, tc.base)
		println("${tc.n:12} (base ${tc.base:2}) has additive persistence $p and digital root ${strconv.format_int(i64(r), tc.base)}",)
		if p != tc.persistence || r != tc.root {
			panic("bad result: $tc $p $r")
		}
	}
}


@let {
  sumDigits ^(@sum @arr)
  drootl    &\@rangef [. sumDigits ^(\~>1 #@arr)]

  droot     ^(@last drootl)
  apers     ^(#-drootl)

  [
    !console.log "[number]: [digital root] [additive persistence] [intermediate sums]"
    [email protected] [627615 39390 588225 393900588225]
      &n !console.log "{n}: {!droot n} {!apers n} {@str !drootl n}"
  ]
}


import std.stdio, std.algorithm, std.string, std.parallelism,
       core.sync.mutex;

void eat(in size_t i, in string name, Mutex[] forks) {
    writeln(name, " is hungry.");
    immutable j = (i + 1) % forks.length;

    // Take forks i and j. The lower one first to prevent deadlock.
    auto fork1 = forks[min(i, j)];
    auto fork2 = forks[max(i, j)];

    fork1.lock;
    scope(exit) fork1.unlock;

    fork2.lock;
    scope(exit) fork2.unlock;

    writeln(name, " is eating.");
    writeln(name, " is full.");
}

void think(in string name) {
    writeln(name, " is thinking.");
}

void main() {
    const philosophers = "Aristotle Kant Spinoza Marx Russell".split;
    Mutex[philosophers.length] forks;
    foreach (ref fork; forks)
        fork = new Mutex;

    defaultPoolThreads = forks.length;
    foreach (i, philo; taskPool.parallel(philosophers)) {
        foreach (immutable _; 0 .. 100) {
            eat(i, philo, forks);
            philo.think;
        }
    }
}


import "/fmt" for Fmt

var sumDigits = Fn.new { |n|
    var sum = 0
    while (n > 0) {
        sum = sum + (n%10)
        n = (n/10).floor
    }
    return sum
}

var digitalRoot = Fn.new { |n|
    if (n < 0) Fiber.abort("Argument must be non-negative.")
    if (n < 10) return [n, 0]
    var dr = n
    var ap = 0
    while (dr > 9) {
        dr = sumDigits.call(dr)
        ap = ap + 1
    }
    return [dr, ap]
}

var a = [1, 14, 267, 8128, 627615, 39390, 588225, 393900588225]
for (n in a) {
    var res = digitalRoot.call(n)
    var dr = res[0]
    var ap = res[1]
    Fmt.print("$,15d has additive persistence $d and digital root of $d", n, ap, dr)
}


include c:\cxpl\codes;                  \intrinsic 'code' declarations

func DRoot(N, B, P);                    \Return digital root and persistance P
real N, B; int P;
int  S;
[P(0):= 0;
while N >= B do
        [S:= 0;
        repeat  S:= S + fix(Mod(N,B));  \sum last digit
                N:= N/B;                \remove last digit
                N:= N - Mod(N,1.);
        until   N < 0.1;                \(beware of rounding errors)
        P(0):= P(0)+1;                  \increment persistance
        N:= float(S);
        ];
return fix(N);
];

real Tbl;
int  I, Root, Pers;
[Tbl:= [627615., 39390., 588225., 393900588225.];
for I:= 0 to 4-1 do
        [Root:= DRoot(Tbl(I), 10., @Pers);
        IntOut(0, Pers);  ChOut(0, ^ );  IntOut(0, Root);  CrLf(0);
        ];
]


program dining_philosophers;
uses
  Classes,
  SysUtils,
  SyncObjs;

const
  PHIL_COUNT   = 5;
  LIFESPAN     = 7;
  DELAY_RANGE  = 950;
  DELAY_LOW    = 50;
  PHIL_NAMES: array[1..PHIL_COUNT] of string = ('Aristotle', 'Kant', 'Spinoza', 'Marx', 'Russell');
type
  TFork        = TCriticalSection;
//  TPhilosopher = class;
  TPhilosopher = class(TThread)
  private
    FName: string;
    FFirstFork, FSecondFork: TFork;
  protected
    procedure Execute; override;
  public
    constructor Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
  end;

var
  Forks: array[1..PHIL_COUNT] of TFork;
  Philosophers: array[1..PHIL_COUNT] of TPhilosopher;

procedure TPhilosopher.Execute;
var
  LfSpan: Integer;
begin
  LfSpan := LIFESPAN;
  while LfSpan > 0 do
    begin
      Dec(LfSpan);
      WriteLn(FName, ' sits down at the table');
      FFirstFork.Acquire;
      FSecondFork.Acquire;
      WriteLn(FName, ' eating');
      Sleep(Random(DELAY_RANGE) + DELAY_LOW);
      FSecondFork.Release;
      FFirstFork.Release;
      WriteLn(FName, ' is full and leaves the table');
      if LfSpan = 0 then
        continue;
      WriteLn(FName, ' thinking');
      Sleep(Random(DELAY_RANGE) + DELAY_LOW);
      WriteLn(FName, ' is hungry');
    end;
end;

constructor TPhilosopher.Create(const aName: string; aForkIdx1, aForkIdx2: Integer);
begin
  inherited Create(True);
  FName := aName;
  if aForkIdx1 < aForkIdx2 then
    begin
      FFirstFork := Forks[aForkIdx1];
      FSecondFork := Forks[aForkIdx2];
    end
  else
    begin
      FFirstFork := Forks[aForkIdx2];
      FSecondFork := Forks[aForkIdx1];
    end;
end;

procedure DinnerBegin;
var
  I: Integer;
  Phil: TPhilosopher;
begin
  for I := 1 to PHIL_COUNT do
    Forks[I] := TFork.Create;
  for I := 1 to PHIL_COUNT do
    Philosophers[I] := TPhilosopher.Create(PHIL_NAMES[I], I, Succ(I mod PHIL_COUNT));
  for Phil in Philosophers do
    Phil.Start;
end;

procedure WaitForDinnerOver;
var
  Phil: TPhilosopher;
  Fork: TFork;
begin
  for Phil in Philosophers do
    begin
      Phil.WaitFor;
      Phil.Free;
    end;
  for Fork in Forks do
    Fork.Free;
end;

begin
  Randomize;
  DinnerBegin;
  WaitForDinnerOver;
  readln;
end.