DECLARE SUB digitalRoot (what AS LONG)

'test inputs:
digitalRoot 627615
digitalRoot 39390
digitalRoot 588225

SUB digitalRoot (what AS LONG)
    DIM w AS LONG, t AS LONG, c AS INTEGER

    w = ABS(what)
    IF w > 10 THEN
        DO
            c = c + 1
            WHILE w
                t = t + (w MOD (10))
                w = w \ 10
            WEND
            w = t
            t = 0
        LOOP WHILE w > 9
    END IF
    PRINT what; ": additive persistance "; c; ", digital root "; w
END SUB


:: Digital Root Task from Rosetta Code Wiki
:: Batch File Implementation
:: (Base 10)

@echo off
setlocal enabledelayedexpansion

:: THE MAIN THING
for %%x in (9876543214 393900588225 1985989328582 34559) do call :droot %%x
echo(
pause
exit /b
:: /THE MAIN THING

:: THE FUNCTION
:droot
set inp2sum=%1
set persist=1

:cyc1
set sum=0
set scan_digit=0
:cyc2
set digit=!inp2sum:~%scan_digit%,1!
if "%digit%"=="" (goto :sumdone)
set /a sum+=%digit%
set /a scan_digit+=1
goto :cyc2

:sumdone
if %sum% lss 10 (
	echo(
	echo ^(%1^)
	echo Additive Persistence=%persist% Digital Root=%sum%.
	goto :EOF
)
set /a persist+=1
set inp2sum=%sum%
goto :cyc1
:: /THE FUNCTION


      *FLOAT64
      PRINT "Digital root of 627615 is "; FNdigitalroot(627615, 10, p) ;
      PRINT " (additive persistence " ; p ")"
      PRINT "Digital root of 39390 is "; FNdigitalroot(39390, 10, p) ;
      PRINT " (additive persistence " ; p ")"
      PRINT "Digital root of 588225 is "; FNdigitalroot(588225, 10, p) ;
      PRINT " (additive persistence " ; p ")"
      PRINT "Digital root of 393900588225 is "; FNdigitalroot(393900588225, 10, p) ;
      PRINT " (additive persistence " ; p ")"
      PRINT "Digital root of 9992 is "; FNdigitalroot(9992, 10, p) ;
      PRINT " (additive persistence " ; p ")"
      END

      DEF FNdigitalroot(n, b, RETURN c)
      c = 0
      WHILE n >= b
        c += 1
        n = FNdigitsum(n, b)
      ENDWHILE
      = n

      DEF FNdigitsum(n, b)
      LOCAL q, s
      WHILE n <> 0
        q = INT(n / b)
        s += n - q * b
        n = q
      ENDWHILE
      = s


DSum ← +´10{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Root ← 0⊸{(×○⌊÷⟜10)◶⟨𝕨‿𝕩,(1+𝕨)⊸𝕊 Dsum⟩𝕩}

P ← •Show ⊢∾Root
P 627615
P 39390
P 588225
P 393900588225


  ( root
  =   sum persistence n d
    .   !arg:(~>9.?)
      |   !arg:(?n.?persistence)
        & 0:?sum
        & ( @( !n
             :   ?
                 (#%@?d&!d+!sum:?sum&~)
                 ?
             )
          | root$(!sum.!persistence+1)
          )
  )
& (   627615 39390 588225 393900588225 10 199
    :   ?
        ( #%@?N
        & root$(!N.0):(?Sum.?Persistence)
        &   out
          $ ( !N
              "has additive persistence"
              !Persistence
              "and digital root of"
              !Sum
            )
        & ~
        )
        ?
  | done
  );


#include <stdio.h>

int droot(long long int x, int base, int *pers)
{
	int d = 0;
	if (pers)
		for (*pers = 0; x >= base; x = d, (*pers)++)
			for (d = 0; x; d += x % base, x /= base);
	else if (x && !(d = x % (base - 1)))
			d = base - 1;

	return d;
}

int main(void)
{
	int i, d, pers;
	long long x[] = {627615, 39390, 588225, 393900588225LL};

	for (i = 0; i < 4; i++) {
		d = droot(x[i], 10, &pers);
		printf("%lld: pers %d, root %d\n", x[i], pers, d);
	}

	return 0;
}


using System;
using System.Linq;

class Program
{
    static Tuple<int, int> DigitalRoot(long num)
    {
        int additivepersistence = 0;
        while (num > 9)
        {
            num = num.ToString().ToCharArray().Sum(x => x - '0');
            additivepersistence++;
        }
        return new Tuple<int, int>(additivepersistence, (int)num);
    }
    static void Main(string[] args)
    {
        foreach (long num in new long[] { 627615, 39390, 588225, 393900588225 })
        {
            var t = DigitalRoot(num);
            Console.WriteLine("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2);
        }
    }
}


// Calculate the Digital Root and Additive Persistance of an Integer - Compiles with gcc4.7
//
// Nigel Galloway. July 23rd., 2012
//
#include <iostream>
#include <cmath>
#include <utility>

template<class P_> P_ IncFirst(const P_& src) {return P_(src.first + 1, src.second);}

std::pair<int, int> DigitalRoot(unsigned long long digits, int base = 10)
{
    int x = SumDigits(digits, base);
    return x < base ? std::make_pair(1, x) : IncFirst(DigitalRoot(x, base));  // x is implicitly converted to unsigned long long; this is lossless
}

int main() {
    const unsigned long long ip[] = {961038,923594037444,670033,448944221089};
    for (auto i:ip){
        auto res = DigitalRoot(i);
        std::cout << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
    }
    std::cout << "\n";
    const unsigned long long hip[] = {0x7e0,0x14e344,0xd60141,0x12343210};
    for (auto i:hip){
        auto res = DigitalRoot(i,16);
        std::cout << std::hex << i << " has digital root " << res.second << " and additive persistance " << res.first << "\n";
    }
    return 0;
}


(defn dig-root [value]
  (let [digits (fn [n]
                 (map #(- (byte %) (byte \0))
                      (str n)))
        sum    (fn [nums]
                 (reduce + nums))]
    (loop [n    value
           step 0]
      (if (< n 10)
        {:n value :add-persist step :digital-root n}
        (recur (sum (digits n))
               (inc step))))))


sum_digits = proc (n, base: int) returns (int)
    sum: int := 0
    while n > 0 do
        sum := sum + n // base
        n := n / base
    end
    return (sum)
end sum_digits

digital_root = proc (n, base: int) returns (int, int)
    persistence: int := 0
    while n >= base do
        persistence := persistence + 1
        n := sum_digits(n, base)
    end
    return (n, persistence)
end digital_root

start_up = proc ()
    po: stream := stream$primary_output()
    tests: array[int] := array[int]$[627615, 39390, 588225, 393900588225]

    for test: int in array[int]$elements(tests) do
        root, persistence: int := digital_root(test, 10)
        stream$putl(po, int$unparse(test)
                        || " has additive persistence "
                        || int$unparse(persistence)
                        || " and digital root of "
                        || int$unparse(root))
    end
end start_up


(defun digital-root (number &optional (base 10))
  (loop for n = number then s
        for ap = 1 then (1+ ap)
        for s = (sum-digits n base)
        when (< s base)
          return (values s ap)))

(loop for (nr base) in '((627615 10) (393900588225 10) (#X14e344 16) (#36Rdg9r 36))
      do (multiple-value-bind (dr ap) (digital-root nr base)
           (format T "~vR (base ~a): additive persistence = ~a, digital root = ~vR~%"
                   base nr base ap base dr)))


MODULE DigitalRoot;
IMPORT StdLog, Strings, TextMappers, DevCommanders;

PROCEDURE CalcDigitalRoot(x: LONGINT; OUT dr,pers: LONGINT);
VAR
	str: ARRAY 64 OF CHAR;
	i: INTEGER;
BEGIN
	dr := 0;pers := 0;
	LOOP
		Strings.IntToString(x,str);
		IF LEN(str$) = 1 THEN dr := x ;EXIT END;
		i := 0;dr := 0;
		WHILE (i < LEN(str$)) DO
			INC(dr,ORD(str[i]) - ORD('0'));
			INC(i)
		END;
		INC(pers);
		x := dr
	END;
END CalcDigitalRoot;

PROCEDURE Do*;
VAR
	dr,pers: LONGINT;
	s: TextMappers.Scanner;
BEGIN
	s.ConnectTo(DevCommanders.par.text);
	s.SetPos(DevCommanders.par.beg);
	REPEAT
		s.Scan;
		IF (s.type = TextMappers.int) OR (s.type = TextMappers.lint) THEN
			CalcDigitalRoot(s.int,dr,pers);
			StdLog.Int(s.int);
			StdLog.String(" Digital root: ");StdLog.Int(dr);
			StdLog.String(" Persistence: ");StdLog.Int(pers);StdLog.Ln
		END
	UNTIL s.rider.eot;
END Do;
END DigitalRoot.


with Ada.Text_IO;

procedure Single_Instance is

   package IO renames Ada.Text_IO;
   Lock_File: IO.File_Type;
   Lock_File_Name: String := "single_instance.magic_lock";

begin
   begin
      IO.Open(File => Lock_File, Mode=> IO.In_File, Name => Lock_File_Name);
      IO.Close(Lock_File);
      IO.Put_Line("I can't -- another instance of me is running ...");
   exception
      when IO.Name_Error =>
         IO.Put_Line("I can run!");
         IO.Create(File => Lock_File, Name => Lock_File_Name);
         for I in 1 .. 10 loop
            IO.Put(Integer'Image(I));
            delay 1.0; -- wait one second
         end loop;
         IO.Delete(Lock_File);
         IO.New_Line;
         IO.Put_Line("I am done!");
   end;
exception
   when others => IO.Delete(Lock_File);
end Single_Instance;


       IDENTIFICATION DIVISION.
       PROGRAM-ID. DIGITAL-ROOT.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 VARIABLES.
          03 INPUT-NUMBER     PIC 9(16).
          03 INPUT-DIGITS     REDEFINES INPUT-NUMBER,
                              PIC 9 OCCURS 16 TIMES.
          03 DIGIT-SUM        PIC 999.
          03 DIGIT-NO         PIC 99.
          03 PERSISTENCE      PIC 9.

       01 OUTPUT-FORMAT.
          03 O-NUMBER         PIC Z(15)9.
          03 FILLER           PIC X(16) VALUE ': PERSISTENCE = '.
          03 O-PERSISTENCE    PIC Z9.
          03 FILLER           PIC X(9) VALUE ', ROOT = '.
          03 O-ROOT           PIC Z9.

       PROCEDURE DIVISION.
       BEGIN.
           MOVE 627615 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
           MOVE 39390 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
           MOVE 588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
           MOVE 393900588225 TO INPUT-NUMBER, PERFORM FIND-DIGITAL-ROOT.
           STOP RUN.

       FIND-DIGITAL-ROOT.
           MOVE ZERO TO PERSISTENCE.
           MOVE INPUT-NUMBER TO O-NUMBER.
           PERFORM SUMMATION UNTIL INPUT-NUMBER IS LESS THAN 10.
           MOVE INPUT-NUMBER TO O-ROOT.
           MOVE PERSISTENCE TO O-PERSISTENCE.
           DISPLAY OUTPUT-FORMAT.

       SUMMATION.
           MOVE ZERO TO DIGIT-SUM.
           ADD 1 TO PERSISTENCE.
           PERFORM ADD-DIGIT VARYING DIGIT-NO FROM 1 BY 1
               UNTIL DIGIT-NO IS GREATER THAN 16.
           MOVE DIGIT-SUM TO INPUT-NUMBER.

       ADD-DIGIT.
           ADD INPUT-DIGITS(DIGIT-NO) TO DIGIT-SUM.


include "cowgol.coh";

# Calculate the digital root and additive persistance of a number
# in a given base
sub digital_root(n: uint32, base: uint32): (root: uint32, pers: uint8) is
    pers := 0;
    while base < n loop
        var step: uint32 := 0;
        while n > 0 loop
            step := step + (n % base);
            n := n / base;
        end loop;
        pers := pers + 1;
        n := step;
    end loop;
    root := n;
end sub;

# Print digital root and persistence (in base 10)
sub test(n: uint32) is
    var root: uint32;
    var pers: uint8;

    (root, pers) := digital_root(n, 10);

    print_i32(n);
    print(": root = ");
    print_i32(root);
    print(", persistence = ");
    print_i8(pers);
    print_nl();
end sub;

test(4);
test(627615);
test(39390);
test(588225);
test(9992);


PRAGMA INCLUDE <sys/file.h>
OPTION DEVICE O_NONBLOCK

OPEN ME$ FOR DEVICE AS me

IF flock(me, LOCK_EX | LOCK_NB) <> 0 THEN
    PRINT "I am already running, exiting..."
    END
ENDIF

PRINT "Running this program, doing things..."
SLEEP 5000

CLOSE DEVICE me


local fd=${2:-200}

# create lock file
eval "exec $fd>/tmp/my_lock.lock"

# acquire the lock, or fail
flock -nx $fd \
&& # do something if you got the lock \
|| # do something if you did not get the lock


      SYS "CreateMutex", 0, 1, "UniqueLockName" TO Mutex%
      SYS "GetLastError" TO lerr%
      IF lerr% = 183 THEN
        SYS "CloseHandle", Mutex%
        SYS "MessageBox", @hwnd%, "I am already running", 0, 0
        QUIT
      ENDIF

      SYS "ReleaseMutex", Mutex%
      SYS "CloseHandle", Mutex%
      END


#include <fcntl.h>	/* fcntl, open */
#include <stdlib.h>	/* atexit, getenv, malloc */
#include <stdio.h>	/* fputs, printf, puts, snprintf */
#include <string.h>	/* memcpy */
#include <unistd.h>	/* sleep, unlink */

/* Filename for only_one_instance() lock. */
#define INSTANCE_LOCK "rosetta-code-lock"

void
fail(const char *message)
{
	perror(message);
	exit(1);
}

/* Path to only_one_instance() lock. */
static char *ooi_path;

void
ooi_unlink(void)
{
	unlink(ooi_path);
}

/* Exit if another instance of this program is running. */
void
only_one_instance(void)
{
	struct flock fl;
	size_t dirlen;
	int fd;
	char *dir;

	/*
	 * Place the lock in the home directory of this user;
	 * therefore we only check for other instances by the same
	 * user (and the user can trick us by changing HOME).
	 */
	dir = getenv("HOME");
	if (dir == NULL || dir[0] != '/') {
		fputs("Bad home directory.\n", stderr);
		exit(1);
	}
	dirlen = strlen(dir);

	ooi_path = malloc(dirlen + sizeof("/" INSTANCE_LOCK));
	if (ooi_path == NULL)
		fail("malloc");
	memcpy(ooi_path, dir, dirlen);
	memcpy(ooi_path + dirlen, "/" INSTANCE_LOCK,
	    sizeof("/" INSTANCE_LOCK));  /* copies '\0' */

	fd = open(ooi_path, O_RDWR | O_CREAT, 0600);
	if (fd < 0)
		fail(ooi_path);

	fl.l_start = 0;
	fl.l_len = 0;
	fl.l_type = F_WRLCK;
	fl.l_whence = SEEK_SET;
	if (fcntl(fd, F_SETLK, &fl) < 0) {
		fputs("Another instance of this program is running.\n",
		    stderr);
		exit(1);
	}

	/*
	 * Run unlink(ooi_path) when the program exits. The program
	 * always releases locks when it exits.
	 */
	atexit(ooi_unlink);
}

/*
 * Demo for Rosetta Code.
 * http://rosettacode.org/wiki/Determine_if_only_one_instance_is_running
 */
int
main()
{
	int i;

	only_one_instance();

	/* Play for 10 seconds. */
	for(i = 10; i > 0; i--) {
		printf("%d...%s", i, i % 5 == 1 ? "\n" : " ");
		fflush(stdout);
		sleep(1);
	}
	puts("Fin!");
	return 0;
}


def digital_root(n : Int, base = 10) : Int
  max_single_digit = base - 1
  n = n.abs
  if n > max_single_digit
    n = 1 + (n - 1) % max_single_digit
  end
  n
end

puts digital_root 627615
puts digital_root 39390
puts digital_root 588225
puts digital_root 7, base: 3


import std.stdio, std.typecons, std.conv, std.bigint, std.math,
       std.traits;

Tuple!(uint, Unqual!T) digitalRoot(T)(in T inRoot, in uint base)
pure nothrow
in {
    assert(base > 1);
} body {
    Unqual!T root = inRoot.abs;
    uint persistence = 0;
    while (root >= base) {
        auto num = root;
        root = 0;
        while (num != 0) {
            root += num % base;
            num /= base;
        }
        persistence++;
    }
    return typeof(return)(persistence, root);
}

void main() {
    enum f1 = "%s(%d): additive persistance= %d, digital root= %d";
    foreach (immutable b; [2, 3, 8, 10, 16, 36]) {
        foreach (immutable n; [5, 627615, 39390, 588225, 393900588225])
            writefln(f1, text(n, b), b, n.digitalRoot(b)[]);
        writeln;
    }

    enum f2 = "<BIG>(%d): additive persistance= %d, digital root= %d";
    immutable n = BigInt("581427189816730304036810394583022044713" ~
                         "00738980834668522257090844071443085937");
    foreach (immutable b; [2, 3, 8, 10, 16, 36])
        writefln(f2, b, n.digitalRoot(b)[]); // Shortened output.
}


using System;
using System.Net;
using System.Net.Sockets;

class Program {
    static void Main(string[] args) {
        try {
            TcpListener server = new TcpListener(IPAddress.Any, 12345);
            server.Start();
        }

        catch (SocketException e) {
            if (e.SocketErrorCode == SocketError.AddressAlreadyInUse) {
                Console.Error.WriteLine("Already running.");
            }
        }
    }
}


(import (java.net ServerSocket InetAddress))

(def *port* 12345) ; random large port number
(try (new ServerSocket *port* 10 (. InetAddress getLocalHost))
     (catch IOException e (System/exit 0))) ; port taken, so app is already running


bool is_unique_instance()
{
    import std.socket;
    auto socket = new Socket(AddressFamily.UNIX, SocketType.STREAM);
    auto addr = new UnixAddress("\0/tmp/myapp.uniqueness.sock");
    try
    {
        socket.bind(addr);
        return true;
    }
    catch (SocketOSException e)
    {
        import core.stdc.errno : EADDRINUSE;

        if (e.errorCode == EADDRINUSE)
            return false;
        else
            throw e;
    }
}


$ x = p1
$ count = 0
$ sum = x
$ loop1:
$  length = f$length( x )
$  if length .eq. 1 then $ goto done
$  i = 0
$  sum = 0
$  loop2:
$   digit = f$extract( i, 1, x )
$   sum = sum + digit
$   i = i + 1
$   if i .lt. length then $ goto loop2
$  x = f$string( sum )
$  count = count + 1
$  goto loop1
$ done:
$ write sys$output p1, " has additive persistence ", count, " and digital root of ", sum


class
	APPLICATION

inherit
	ARGUMENTS

create
	make

feature {NONE} -- Initialization

	digital_root_test_values: ARRAY [INTEGER_64]
			-- Test values.
		once
		 	Result := <<670033, 39390, 588225, 393900588225>> -- base 10
		end

	digital_root_expected_result: ARRAY [INTEGER_64]
			-- Expected result values.
		once
			Result := <<1, 6, 3, 9>> -- base 10
		end

	make
		local
			results: ARRAY [INTEGER_64]
			i: INTEGER
		do
			from
				i := 1
			until
				i > digital_root_test_values.count
			loop
				results := compute_digital_root (digital_root_test_values [i], 10)
				if results [2] ~ digital_root_expected_result [i] then
					print ("%N" + digital_root_test_values [i].out + " has additive persistence " + results [1].out + " and digital root " + results [2].out)
				else
					print ("Error in the calculation of the digital root of " + digital_root_test_values [i].out + ". Expected value: " + digital_root_expected_result [i].out + ", produced value: " + results [2].out)
				end
				i := i	+ 1
			end
		end

compute_digital_root (a_number: INTEGER_64;  a_base: INTEGER): ARRAY [INTEGER_64]
				-- Returns additive persistence and digital root of `a_number' using `a_base'.
		require
                        valid_number: a_number >= 0
                        valid_base: a_base > 1
                local
			temp_num: INTEGER_64
		do
			create Result.make_filled (0, 1, 2)
			from
				Result [2] := a_number
			until
				Result [2] < a_base
			loop
				from
					temp_num := Result [2]
					Result [2] := 0
				until
					temp_num = 0
				loop
					Result [2] := Result [2] + (temp_num \\ a_base)
					temp_num := temp_num // a_base
				end
				Result [1] := Result [1] + 1
			end
		end


program OneInstance;

{$APPTYPE CONSOLE}

uses SysUtils, Windows;

var
  FMutex: THandle;
begin
  FMutex := CreateMutex(nil, True, 'OneInstanceMutex');
  if FMutex = 0 then
    RaiseLastOSError
  else
  begin
    try
      if GetLastError = ERROR_ALREADY_EXISTS then
        Writeln('Program already running.  Closing...')
      else
      begin
        // do stuff ...
        Readln;
      end;
    finally
      CloseHandle(FMutex);
    end;
  end;
end.


7> erlang:register( aname, erlang:self() ).
true
8> erlang:register( aname, erlang:self() ).
** exception error: bad argument
     in function  register/2
        called as register(aname,<0.42.0>)


Shell("tasklist > temp.txt")

Dim linea As String
Open "temp.txt" For Input As #1
Do While Not Eof(1)
    Line Input #1, linea
    If Instr(linea, "fbc.exe") = 0 Then Print "Task is Running" : Exit Do
Loop
Close #1
Shell("del temp.txt")
Sleep


package main

import (
    "fmt"
    "net"
    "time"
)

const lNet = "tcp"
const lAddr = ":12345"

func main() {
    if _, err := net.Listen(lNet, lAddr); err != nil {
        fmt.Println("an instance was already running")
        return
    }
    fmt.Println("single instance started")
    time.Sleep(10 * time.Second)
}


import Control.Concurrent
import System.Directory (doesFileExist, getAppUserDataDirectory,
    removeFile)
import System.IO (withFile, Handle, IOMode(WriteMode), hPutStr)

oneInstance :: IO ()
oneInstance = do
    -- check if file "$HOME/.myapp.lock" exists
    user <- getAppUserDataDirectory "myapp.lock"
    locked <- doesFileExist user
    if locked
    then print "There is already one instance of this program running."
    else do
        t <- myThreadId
        -- this is the entry point to the main program:
        -- withFile creates a file, then calls a function,
        -- then closes the file
        withFile user WriteMode (do_program t)
        -- remove the lock when we're done
        removeFile user

do_program :: ThreadId -> Handle -> IO ()
do_program t h = do
    let s = "Locked by thread: " ++ show t
    -- print what thread has acquired the lock
    putStrLn s
    -- write the same message to the file, to show that the
    -- thread "owns" the file
    hPutStr h s
    -- wait for one second
    threadDelay 1000000

main :: IO ()
main = do
    -- launch the first thread, which will create the lock file
    forkIO oneInstance
    -- wait for half a second
    threadDelay 500000
    -- launch the second thread, which will find the lock file and
    -- thus will exit immediately
    forkIO oneInstance
    return ()


procedure main(A)
   if not open(":"||54321,"na") then stop("Already running")
   repeat {}	# busy loop
end


import java.io.IOException;
import java.net.InetAddress;
import java.net.ServerSocket;
import java.net.UnknownHostException;

public class SingletonApp
{
    private static final int PORT = 65000;  // random large port number
    private static ServerSocket s;

    // static initializer
    static {
        try {
            s = new ServerSocket(PORT, 10, InetAddress.getLocalHost());
        } catch (UnknownHostException e) {
            // shouldn't happen for localhost
        } catch (IOException e) {
            // port taken, so app is already running
            System.out.print("Application is already running,");
            System.out.println(" so terminating this instance.");
            System.exit(0);
        }
    }

    public static void main(String[] args) {
        System.out.print("OK, only this instance is running");
        System.out.println(" but will terminate in 10 seconds.");
        try {
            Thread.sleep(10000);
            if (s != null && !s.isClosed()) s.close();
        } catch (Exception e) {
            System.err.println(e);
        }
    }
}


/* Determine if only one instance, in Jsish */
var sock;

try {
    sock = new Socket({client:false, port:54321});
    puts('\nApplication running for 30 seconds, from', strftime());
    update(30000);
    puts('\nApplication ended at', strftime());
} catch (err) {
    puts('Applicaion already running');
    exit(1);
}


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

extension op
{
    get DigitalRoot()
    {
        int  additivepersistence := 0;
        long num := self;

        while (num > 9)
        {
            num := num.toPrintable().toArray().selectBy:(ch => ch.toInt() - 48).summarize(new LongInteger());

            additivepersistence += 1
        };

        ^ new Tuple<int,int>(additivepersistence, num.toInt())
    }
}

public program()
{
    new long[]{627615l, 39390l, 588225l, 393900588225l}.forEach:(num)
    {
        var t := num.DigitalRoot;

        console.printLineFormatted("{0} has additive persistence {1} and digital root {2}", num, t.Item1, t.Item2)
    }
}


defmodule Digital do
  def root(n, base\\10), do: root(n, base, 0)

  defp root(n, base, ap) when n < base, do: {n, ap}
  defp root(n, base, ap) do
    Integer.digits(n, base) |> Enum.sum |> root(base, ap+1)
  end
end

data = [627615, 39390, 588225, 393900588225]
Enum.each(data, fn n ->
  {dr, ap} = Digital.root(n)
  IO.puts "#{n} has additive persistence #{ap} and digital root of #{dr}"
end)

base = 16
IO.puts "\nBase = #{base}"
fmt = "~.#{base}B(#{base}) has additive persistence ~w and digital root of ~w~n"
Enum.each(data, fn n ->
  {dr, ap} = Digital.root(n, base)
  :io.format fmt, [n, ap, dr]
end)


-module( digital_root ).

-export( [task/0] ).

task() ->
    Ns = [N || N <- [627615, 39390, 588225, 393900588225]],
    Persistances = [persistance_root(X) || X <-	Ns],
    [io:fwrite("~p has additive persistence ~p and digital root of ~p~n", [X, Y, Z]) || {X, {Y, Z}} <- lists:zip(Ns, Persistances)].

persistance_root( X ) -> persistance_root( sum_digits:sum_digits(X), 1 ).

persistance_root( X, N ) when X	< 10 ->	{N, X};
persistance_root( X, N ) -> persistance_root( sum_digits:sum_digits(X),	N + 1 ).


using Sockets

const portnum = 12345

function canopen()
    try
        server = listen(portnum)
        println("This is the only instance.")
        sleep(20)
    catch y
        if findfirst("EADDRINUSE", string(y)) != nothing
            println("There is already an instance running.")
        end
    end
end

canopen()


// version 1.0.6

import java.io.IOException
import java.net.*

object SingleInstance {
    private var ss: ServerSocket? = null

    fun alreadyRunning(): Boolean {
        try {
            ss = ServerSocket(65000, 10, InetAddress.getLocalHost()) // using private port 65000
        }
        catch (e: IOException) {
            // port already in use so an instance is already running
            return true
        }
        return false
    }

    fun close() {
        if (ss == null || ss?.isClosed() == true) return
        ss?.close()
    }
}

fun main(args: Array<String>) {
    if (SingleInstance.alreadyRunning()) {
        println("Application is already running, so terminating this instance")
        System.exit(0)
    }
    else {
        println("OK, only this instance is running but will terminate in 10 seconds")
        Thread.sleep(10000)
        SingleInstance.close()
    }
}


#!/usr/bin/lasso9

local(lockfile = file('/tmp/myprocess.lockfile'))

if(#lockfile -> exists) => {
	stdoutnl('Error: App is running as of ' + #lockfile -> readstring)
	abort
}

handle => {
	#lockfile -> delete
}

stdoutnl('Starting execution')

#lockfile -> doWithClose => {
	#lockfile -> writebytes(bytes(date))
}

sleep(10000)

stdoutnl('Execution done')


'Create a Mutex to prevent more than one instance from being open at a single time.
CallDLL #kernel32, "CreateMutexA", 0 as Long, 1 as Long, "Global\My Program" as ptr, mutex as ulong
CallDLL #kernel32, "GetLastError", LastError as Long

if LastError = 183 then 'Error returned when a Mutex already exists
    'Close the handle if the mutex already exists
    calldll #kernel32, "CloseHandle", mutex as ulong, ret as ulong
    notice "An instance of My Program is currently running!"
    end
end if

'Release the Mutex/ Close the handle prior to ending the program
'Comment out these lines to allow the program to remain active to test for the mutex's presence
calldll #kernel32, "ReleaseMutex", mutex as ulong, ret as ulong
calldll #kernel32, "CloseHandle", mutex as ulong, ret as ulong
end


//Find the Digital Root of An Integer - Nigel Galloway: February 1st., 2015
//This code will work with any integer type
let inline digitalRoot N BASE =
  let rec root(p,n) =
    let s = sumDigits n BASE
    if s < BASE then (s,p) else root(p+1, s)
  root(LanguagePrimitives.GenericZero<_> + 1, N)


USING: arrays formatting kernel math math.text.utils sequences ;
IN: rosetta-code.digital-root

: digital-root ( n -- persistence root )
    0 swap [ 1 digit-groups dup length 1 > ] [ sum [ 1 + ] dip ]
    while first ;

: print-root ( n -- )
    dup digital-root
    "%-12d has additive persistence %d and digital root %d.\n"
    printf ;

{ 627615 39390 588225 393900588225 } [ print-root ] each


: (Sdigit) 0 swap begin base @ /mod >r + r> dup 0= until drop ;
: digiroot 0 swap begin (Sdigit) >r 1+ r> dup base @ < until ;


Module Checkit {
      Try {
            Open "MYLOCK" For Output Exclusive As #F
            Print "DO SOMETHING"
            A$=Key$
            Close#f
      }
}


$Epilog := Print["Another instance is running "];
If[Attributes[Global`Mutex] == {Protected},
 Exit[],
 Global`Mutex[x_] := Locked; Protect[Global`Mutex];
 ]


import os, posix

let fn = getHomeDir() & "rosetta-code-lock"
proc ooiUnlink {.noconv.} = discard unlink fn

proc onlyOneInstance =
  var fl = TFlock(lType: F_WRLCK.cshort, lWhence: SEEK_SET.cshort)
  var fd = getFileHandle fn.open fmReadWrite
  if fcntl(fd, F_SETLK, addr fl) < 0:
    stderr.writeLine "Another instance of this program is running"
    quit 1
  addQuitProc ooiUnlink

onlyOneInstance()

for i in countdown(10, 1):
  echo i
  sleep 1000
echo "Fin!"


open Sem

let () =
  let oflags = [Unix.O_CREAT;
                Unix.O_EXCL] in
  let sem = sem_open "MyUniqueName" ~oflags () in
  (* here the real code of the app *)
  Unix.sleep 20;
  (* end of the app *)
  sem_unlink "MyUniqueName";
  sem_close sem


functor
import Application Open System
define
   fun {IsAlreadyRunning}
      try
	 S = {New Open.socket init}
      in
	 {S bind(takePort:12345)}
	 false
      catch system(os(os "bind" ...) ...) then
	 true
      end
   end

   if {IsAlreadyRunning} then
      {System.showInfo "Exiting because already running."}
      {Application.exit 1}
   end
   {System.showInfo "Press enter to exit."}
   {{New Open.file init(name:stdin)} read(list:_ size:1)}
   {Application.exit 0}
end


use Fcntl ':flock';

INIT
{
	die "Not able to open $0\n" unless (open ME, $0);
	die "I'm already running !!\n" unless(flock ME, LOCK_EX|LOCK_NB);
}

sleep 60; # then your code goes here


program prec
implicit none
integer(kind=16) :: i
i = 627615
call root_pers(i)
i = 39390
call root_pers(i)
i = 588225
call root_pers(i)
i = 393900588225
call root_pers(i)
end program

subroutine root_pers(i)
implicit none
integer(kind=16) :: N, s, a, i
write(*,*) 'Number: ', i
n = i
a = 0
do while(n.ge.10)
  a = a + 1
  s = 0
  do while(n.gt.0)
    s = s + n-int(real(n,kind=8)/10.0D0,kind=8) * 10_8
    n = int(real(n,kind=16)/real(10,kind=8),kind=8)
  end do
  n = s
end do
write(*,*) 'digital root = ', s
write(*,*) 'additive persistance = ', a
end subroutine


' FB 1.05.0 Win64

Function digitalRoot(n As UInteger, ByRef ap As Integer, base_ As Integer = 10) As Integer
  Dim dr As Integer
  ap = 0
  Do
    dr = 0
    While n > 0
      dr += n Mod base_
      n = n \ base_
    Wend
    ap += 1
    n = dr
  Loop until dr < base_
  Return dr
End Function

Dim As Integer dr, ap
Dim a(3) As UInteger = {627615, 39390, 588225, 393900588225}
For i As Integer = 0 To 3
 ap = 0
 dr = digitalRoot(a(i), ap)
 Print a(i), "Additive Persistence ="; ap, "Digital root ="; dr
 Print
Next
Print "Press any key to quit"
Sleep


-- demo\rosetta\Single_instance.exw
without js
include pGUI.e

function copydata_cb(Ihandle /*ih*/, atom pCommandLine, integer size)
    -- (the first instance is sent a copy of the second one's command line)
    printf(1,"COPYDATA(%s, %d)\n",{peek_string(pCommandLine), size});
    return IUP_DEFAULT;
end function

IupOpen()
IupSetGlobal("SINGLEINSTANCE", "Single") -- (must [partially] match the main window title)
if IupGetGlobal("SINGLEINSTANCE")!="" then
    Ihandle dlg = IupDialog(IupVbox({IupLabel("hello")},"MARGIN=200x200"))
    IupSetAttribute(dlg,"TITLE","Single Instance")
    IupSetCallback(dlg, "COPYDATA_CB", Icallback("copydata_cb"));
    IupShow(dlg)
    IupMainLoop()
end if
IupClose()


$ cat myScript
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(wait 120000)
(bye)


if (Get-Process -Name "notepad" -ErrorAction SilentlyContinue)
{
    Write-Warning -Message "notepad is already running."
}
else
{
    Start-Process -FilePath C:\Windows\notepad.exe
}


#MyApp="MyLittleApp"
Mutex=CreateMutex_(0,1,#MyApp)
If GetLastError_()=#ERROR_ALREADY_EXISTS
  MessageRequester(#MyApp,"One instance is already started.")
  End
EndIf

; Main code executes here

ReleaseMutex_(Mutex)
End


import __main__, os

def isOnlyInstance():
    # Determine if there are more than the current instance of the application
    # running at the current time.
    return os.system("(( $(ps -ef | grep python | grep '[" +
                     __main__.__file__[0] + "]" + __main__.__file__[1:] +
                     "' | wc -l) > 1 ))") != 0


package main

import (
	"fmt"
	"log"
	"strconv"
)

func Sum(i uint64, base int) (sum int) {
	b64 := uint64(base)
	for ; i > 0; i /= b64 {
		sum += int(i % b64)
	}
	return
}

func DigitalRoot(n uint64, base int) (persistence, root int) {
	root = int(n)
	for x := n; x >= uint64(base); x = uint64(root) {
		root = Sum(x, base)
		persistence++
	}
	return
}

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

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

func main() {
	for _, tc := range testCases {
		n, err := strconv.ParseUint(tc.n, tc.base, 64)
		if err != nil {
			log.Fatal(err)
		}
		p, r := DigitalRoot(n, tc.base)
		fmt.Printf("%12v (base %2d) has additive persistence %d and digital root %s\n",
			tc.n, tc.base, p, strconv.FormatInt(int64(r), tc.base))
		if p != tc.persistence || r != tc.root {
			log.Fatalln("bad result:", tc, p, r)
		}
	}
}


#lang racket
(define *port* 12345) ; random large port number
(define listener-handler
  (with-handlers ([exn? (λ(e) (printf "Already running, bye.\n") (exit))])
    (tcp-listen *port*)))
(printf "Working...\n")
(sleep 10)


my $name = $*PROGRAM-NAME;
my $pid = $*PID;

my $lockdir = "/tmp";
my $lockfile = "$lockdir/$name.pid";
my $lockpid = "$lockfile$pid";
my $havelock = False;

END {
    unlink $lockfile if $havelock;
    try unlink $lockpid;
}

my $pidfile = open "$lockpid", :w orelse .die;
$pidfile.say($pid);
$pidfile.close;

if try link($lockpid, $lockfile) {
    $havelock = True;
}
else {
    shell "kill -CONT `cat $lockfile` || rm $lockfile";
    if try link($lockfile, $lockpid) {
        $havelock = True;
    }
    else {
        die "You can't run right now!";
    }
}
note "Got lock!";
unlink $lockpid;


/* Simple ARexx program to open a port after checking if it's already open */
IF Show('PORTS','ROSETTA') THEN DO           /* Port is already open; exit */
   SAY 'This program may only be run in a single instance at a time.'
   EXIT 5                                    /* Exit with a mild warning   */
   END
                 /* Open rexxsupport.library so that ports can be opened   */
IF ~Show('LIBRARIES','rexxsupport.library')
   THEN CALL AddLib('rexxsupport.library',0,-30,0)

IF ~OpenPort('ROSETTA')    THEN EXIT 10       /* Open port, end if it fails */

SAY 'Program is now running.'

DO FOREVER                                    /* Busyloop                   */
   /* Program stuff here */
   END

EXIT 0


# Project : Determine if only one instance is running

task = "ringw.exe"
taskname = "tasklist.txt"
remove(taskname)
system("tasklist >> tasklist.txt")
fp = fopen(taskname,"r")
tasks = read("tasklist.txt")
counttask = count(tasks,task)
if counttask > 0
   see task + " running in " + counttask + " instances" + nl
else
   see task + " is not running" + nl
ok

func count(cString,dString)
     sum = 0
     while substr(cString,dString) > 0
           sum++
           cString = substr(cString,substr(cString,dString)+len(string(sum)))
     end
     return sum


def main
  puts "first instance"
  sleep 20
  puts :done
end

if $0 == __FILE__
  if File.new(__FILE__).flock(File::LOCK_EX | File::LOCK_NB)
    main
  else
    raise "another instance of this program is running"
  end
end

__END__


T Edge
   String start
   String end
   Int cost

   F (start, end, cost)
      .start = start
      .end = end
      .cost = cost

T Graph
   [Edge] edges
   Set[String] vertices

   F (edges)
      .edges = edges.map((s, e, c) -> Edge(s, e, c))
      .vertices = Set(.edges.map(e -> e.start)).union(Set(.edges.map(e -> e.end)))

   F dijkstra(source, dest)
      assert(source C .vertices)
      V dist = Dict(.vertices, vertex -> (vertex, Float.infinity))
      V previous = Dict(.vertices, vertex -> (vertex, ‘’))
      dist[source] = 0
      V q = copy(.vertices)
      V neighbours = Dict(.vertices, vertex -> (vertex, [(String, Int)]()))
      L(start, end, cost) .edges
         neighbours[start].append((end, cost))

      L !q.empty
         V u = min(q, key' vertex -> @dist[vertex])
         q.remove(u)
         I dist[u] == Float.infinity | u == dest
            L.break
         L(v, cost) neighbours[u]
            V alt = dist[u] + cost
            I alt < dist[v]
               dist[v] = alt
               previous[v] = u

      Deque[String] s
      V u = dest
      L previous[u] != ‘’
         s.append_left(u)
         u = previous[u]
      s.append_left(u)
      R s

V graph = 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)])
print(graph.dijkstra(‘a’, ‘e’))


if instr(shell$("tasklist"),"rbp.exe") <> 0 then print "Task is Running"


use std::net::TcpListener;

fn create_app_lock(port: u16) -> TcpListener {
    match TcpListener::bind(("0.0.0.0", port)) {
        Ok(socket) => {
            socket
        },
        Err(_) => {
            panic!("Couldn't lock port {}: another instance already running?", port);
        }
    }
}

fn remove_app_lock(socket: TcpListener) {
    drop(socket);
}

fn main() {
    let lock_socket = create_app_lock(12345);
    // ...
    // your code here
    // ...
    remove_app_lock(lock_socket);
}


import java.io.IOException
import java.net.{InetAddress, ServerSocket}

object SingletonApp extends App {
  private val port = 65000

  try {
    val s = new ServerSocket(port, 10, InetAddress.getLocalHost)
  }
  catch {
    case _: IOException =>
      // port taken, so app is already running
      println("Application is already running, so terminating this instance.")
      sys.exit(-1)
  }

  println("OK, only this instance is running but will terminate in 10 seconds.")

  Thread.sleep(10000)

  sys.exit(0)

}


# For this to work, you need to explicitly
# store the returned fh inside a variable.
var fh = File(__FILE__).open_r

# Now call the flock() method on it
fh.flock(File.LOCK_EX | File.LOCK_NB) ->
    || die "I'm already running!"

# Your code here...
say "Running..."
Sys.sleep(20)
say 'Done!'


import Foundation

let globalCenter = NSDistributedNotificationCenter.defaultCenter()
let time = NSDate().timeIntervalSince1970

globalCenter.addObserverForName("OnlyOne", object: nil, queue: NSOperationQueue.mainQueue()) {not in
    if let senderTime = not.userInfo?["time"] as? NSTimeInterval where senderTime != time {
        println("More than one running")
        exit(0)
    } else {
        println("Only one")
    }
}

func send() {
    globalCenter.postNotificationName("OnlyOne", object: nil, userInfo: ["time": time])

    let waitTime = dispatch_time(DISPATCH_TIME_NOW, Int64(3 * NSEC_PER_SEC))

    dispatch_after(waitTime, dispatch_get_main_queue()) {
        send()
    }
}

send()
CFRunLoopRun()


package require Tcl 8.6
try {
    # Pick a port number based on the name of the main script executing
    socket -server {apply {{chan args} {close $chan}}} -myaddr localhost \
            [expr {1024 + [zlib crc32 [file normalize $::argv0]] % 30000}]
} trap {POSIX EADDRINUSE} {} {
    # Generate a nice error message
    puts stderr "Application $::argv0 already running?"
    exit 1
}


private with Ada.Containers.Ordered_Maps;
generic
   type t_Vertex is (<>);
package Dijkstra is

   type t_Graph is limited private;

   -- Defining a graph (since limited private, only way to do this is to use the Build function)
   type t_Edge is record
      From, To : t_Vertex;
      Weight   : Positive;
   end record;
   type t_Edges is array (Integer range <>) of t_Edge;
   function Build (Edges : in t_Edges; Oriented : in Boolean := True) return t_Graph;

   -- Computing path and distance
   type t_Path is array (Integer range <>) of t_Vertex;
   function Shortest_Path (Graph    : in out t_Graph;
                           From, To : in t_Vertex) return t_Path;
   function Distance      (Graph    : in out t_Graph;
                           From, To : in t_Vertex) return Natural;

private
   package Neighbor_Lists is new Ada.Containers.Ordered_Maps (Key_Type => t_Vertex, Element_Type => Positive);
   type t_Vertex_Data is record
      Neighbors : Neighbor_Lists.Map; -- won't be affected after build
      -- Updated each time a function is called with a new source
      Previous  : t_Vertex;
      Distance  : Natural;
   end record;
   type t_Graph is array (t_Vertex) of t_Vertex_Data;
end Dijkstra;


# -*- coding: utf-8 -*- #

COMMENT REQUIRED BY "prelude_dijkstras_algorithm.a68" CO
  MODE ROUTELEN = ~;
  ROUTELEN route len infinity = max ~;
  PROC route len add = (VERTEX v, ROUTE r)ROUTELEN:
    route len OF v + route len OF r; # or MAX(v,r) #
  MODE VERTEXPAYLOAD = ~;
  PROC dijkstra fix value error = (STRING msg)BOOL:
    (put(stand error, (msg, new line)); FALSE);
#PROVIDES:#
# VERTEX*=~* #
# ROUTE*=~* #
# vertex route*=~* #
END COMMENT

MODE VALVERTEX = STRUCT(
    ROUTELEN route len,
    FLEX[0]ROUTE route,
    ROUTE shortest route,
    VERTEXPAYLOAD vertex data
);

MODE VERTEX = REF VALVERTEX;
MODE VERTEXYIELD = PROC(VERTEX)VOID; # used to "generate" VERTEX path #
PRIO INIT = 1; # The same PRIOrity as +:= etc #
OP INIT = (VERTEX self, VERTEXPAYLOAD vertex data)VERTEX:
  self := (route len infinity, (), NIL, vertex data);

# It may be faster to preallocate "queue", rather then grow a FLEX #
OP +:= = (REF FLEX[]VERTEX in list, VERTEX rhs)REF FLEX[]VERTEX: (
  [UPB in list+1]VERTEX out list;
  out list[:UPB in list] := in list;
  out list[UPB out list] := rhs;
  in list := out list # EXIT #
);

MODE VALROUTE = STRUCT(VERTEX from, to, ROUTELEN route len#, ROUTEPAYLOAD#);
MODE ROUTE = REF VALROUTE;

OP +:= = (REF FLEX[]ROUTE in list, ROUTE rhs)REF FLEX[]ROUTE: (
  [UPB in list+1]ROUTE out list;
  out list[:UPB in list] := in list;
  out list[UPB out list] := rhs;
  in list := out list # EXIT #
);

MODE VERTEXROUTE = UNION(VERTEX, ROUTE);
MODE VERTEXROUTEYIELD = PROC(VERTEXROUTE)VOID;

################################################################
# Finally: now the strong typing is in place, the task code... #
################################################################
PROC vertex route gen dijkstra = (
    VERTEX source, target,
    REF[]VALROUTE route list,
    VERTEXROUTEYIELD yield
  )VOID:(

# initialise the route len for BOTH directions on each route #
  FOR this TO UPB route list DO
    ROUTE route = route list[this];
    route OF from OF route +:= route;
# assume route lens is the same in both directions, this i.e. NO A-B gradient NOR 1-way streets #
    route OF to OF route +:= (HEAP VALROUTE := (to OF route, from OF route, route len OF route))
  OD;

  COMMENT
  Algorithium Performance "about" O(n**2)...
  Optimisations:
       a) bound index in [lwb queue:UPB queue] for search
       b) delay adding vertices until they are actually encountered
  It may be faster to preallocate "queue" vertex list, rather then grow a FLEX
  END COMMENT

  PROC vertex gen nearest = (REF FLEX[]VERTEX queue, VERTEXYIELD yield)VOID: (
    INT vertices done := 0, lwb queue := 1;
    ROUTELEN shortest route len done := -route len infinity;
    WHILE vertices done <= UPB queue ANDF shortest route len done NE route len infinity DO
      ROUTELEN shortest route len := route len infinity;
# skip done elements: #
      FOR this FROM lwb queue TO UPB queue DO
        VERTEX this vertex := queue[this];
        IF NOT(shortest route len done < route len OF this vertex) THEN
          lwb queue := this; # remember for next time #
          break
        FI
      OD;
    break:
# find vertex with shortest path attached #
      FOR this FROM lwb queue TO UPB queue DO VERTEX this vertex := queue[this];
        IF shortest route len done < route len OF this vertex ANDF
           route len OF this vertex < shortest route len THEN
           shortest route len := route len OF this vertex FI
      OD;
# update the other vertices with shortest path found #
      FOR this FROM lwb queue TO UPB queue DO VERTEX this vertex := queue[this];
        IF route len OF this vertex = shortest route len THEN
           vertices done +:= 1; yield(this vertex) FI
      OD;
      shortest route len done := shortest route len
    OD
  );

  route len OF target := 0;
  FLEX[0]VERTEX queue := target;

# FOR VERTEX this vertex IN # vertex gen nearest(queue#) DO (#,
##   (VERTEX this vertex)VOID: (
    FOR this TO UPB route OF this vertex DO ROUTE this route = (route OF this vertex)[this];

    # If this vertex has not been encountered before, then add to queue #
      IF route len OF to OF this route = route len infinity THEN queue +:= to OF this route FI;

      ROUTELEN route len = route len add(this vertex, this route);
      IF route len < route len OF to OF this route THEN
        route len OF to OF this route := route len;
        shortest route OF to OF this route := this route
      FI
    OD;

    IF this vertex IS source THEN done FI
# OD#));
  IF NOT dijkstra fix value error("no path found") THEN stop FI;

############################
# Now: generate the result #
############################
  done: (
    VERTEX this vertex := source;
    WHILE
      yield(this vertex);
      ROUTE this route = shortest route OF this vertex;
  # WHILE # this route ISNT ROUTE(NIL) DO
      yield(this route);
      this vertex := from OF this route
    OD
  )
);

SKIP


class DigitalRoot {
    static int[] calcDigitalRoot(String number, int base) {
        BigInteger bi = new BigInteger(number, base)
        int additivePersistence = 0
        if (bi.signum() < 0) {
            bi = bi.negate()
        }
        BigInteger biBase = BigInteger.valueOf(base)
        while (bi >= biBase) {
            number = bi.toString(base)
            bi = BigInteger.ZERO
            for (int i = 0; i < number.length(); i++) {
                bi = bi.add(new BigInteger(number.substring(i, i + 1), base))
            }
            additivePersistence++
        }
        return [additivePersistence, bi.intValue()]
    }

    static void main(String[] args) {
        for (String arg : [627615, 39390, 588225, 393900588225]) {
            int[] results = calcDigitalRoot(arg, 10)
            println("$arg has additive persistence ${results[0]} and digital root of ${results[1]}")
        }
    }
}


import Data.Bifunctor (bimap)
import Data.List (unfoldr)
import Data.Tuple (swap)

digSum :: Int -> Int -> Int
digSum base = sum . unfoldr f
  where
    f 0 = Nothing
    f n = Just (swap (quotRem n base))

digRoot :: Int -> Int -> (Int, Int)
digRoot base =
  head .
  dropWhile ((>= base) . snd) . iterate (bimap succ (digSum base)) . (,) 0

main :: IO ()
main = do
  putStrLn "in base 10:"
  mapM_ (print . ((,) <*> digRoot 10)) [627615, 39390, 588225, 393900588225]


;;; Define some typedefs for clear correspondence with Win32
(typedef HANDLE cptr)
(typedef LPSECURITY_ATTRIBUTES cptr)
(typedef WINERR (enum WINERR ERROR_SUCCESS
                             (ERROR_ALREADY_EXISTS 183)))
(typedef BOOL (enum BOOL FALSE TRUE))
(typedef LPCWSTR wstr)

;;; More familiar spelling for null pointer.
(defvarl NULL cptr-null)

;;; Define access to foreign functions.
(with-dyn-lib "kernel32.dll"
  (deffi CreateMutex "CreateMutexW" HANDLE (LPSECURITY_ATTRIBUTES BOOL LPCWSTR))
  (deffi CloseHandle "CloseHandle" BOOL (HANDLE))
  (deffi GetLastError "GetLastError" WINERR ()))

;;; Now, the single-instance program:
(defvar m (CreateMutex NULL 'TRUE "ApplicationName"))

(unless (eq (GetLastError) 'ERROR_ALREADY_EXISTS)
  ;; mutual exclusion here
  )

(CloseHandle m)


# (c) Copyright 2005 Mark Hobley
#
# This is free software. This file can be redistributed or modified
# under the terms of version 1.2 of the GNU Free Documentation Licence
# as published by the Free Software Foundation.
#

 singleinstance ()
 {
   if [ -d $SRUNDIR ] ; then
     if [ -w $SRUNDIR ] ; then
       if [ -d $SRUNDIR/$APPNAME ] ; then
         echo "Process Already Running" >& 2
         return 221
       else
         mkdir $SRUNDIR/$APPNAME
         if [ "$?" -ne 0 ] ; then
           if [ -d $SRUNDIR/$APPNAME ] ; then
             echo "Process Already Running" >& 2
             return 221
           else
             echo "Unexpected Error" >& 2
             return 239
           fi
         fi
         return 0 ; # This is a unique instance
       fi
     else
       echo "Permission Denied" >& 2
       return 210
     fi
   else
     echo "Missing Directory" >& 2
     return 199
   fi
 }


Dim onlyInstance as Boolean
onlyInstance = not App.PrevInstance


import "io" for File, FileFlags

var specialFile = "wren-exclusive._sp"
var checkOneInstanceRunning = Fn.new {
    // attempt to create the special file with exclusive access
    var ff = FileFlags.create | FileFlags.exclusive
    File.openWithFlags(specialFile, ff) { |file| }  // closes automatically if successful
}

// check if the current instance is the only one running
var fiber = Fiber.new {
    checkOneInstanceRunning.call()
}
var error = fiber.try()
if (error) {
    System.print("An instance is already running.")
    return
}

// do something that takes a while for testing purposes
var sum = 0
for (i in 1...1e8) {
   sum = sum + i
}
System.print(sum)

File.delete(specialFile) // clean up


100 O$ = "A" : T$ = "EF"
110 DEF FN N(P) = ASC(MID$(N$,P+(P=0),1))-64
120 DIM D(26),UNVISITED(26)
130 DIM PREVIOUS(26) : TRUE = 1
140 LET M = -1 : INFINITY = M
150 FOR I = 0 TO 26
160     LET D(I) = INFINITY : NEXT
170 FOR NE = M TO 1E38 STEP .5
180     READ C$
190     IF LEN(C$) THEN NEXT
200 DIM C(NE),FROM(NE),T(NE)
210 DIM PC(NE) : RESTORE
220 FOR I = 0 TO NE
230     READ C(I), N$
240     LET FROM(I) = FN N(1)
250     LET UNVISITED(FR(I)) = TRUE
260     LET T(I) = FN N(3)
270     LET UNVISITED(T(I)) = TRUE
290 NEXT
300 N$ = O$ : O = FN N(0)
310 D(O) = 0
320 FOR CV = O TO EMPTY STEP 0
330     FOR I = 0 TO NE
340         IF FROM(I) = CV THEN N = T(I) : D = D(CV) + C(I) : IF (D(N) = INFINITY) OR (D < D(N)) THEN D(N) = D : PREVIOUS(N) = CV : PC(N) = C(I)
350     NEXT I
360     LET UNVISITED(CV) = FALSE
370     LET MV =  EMPTY
380     FOR I = 1 TO 26
390         IF UNVISITED(I) THEN MD = D(MV) * (MV <> INFINITY) + INFINITY * (MV = INFINITY) : IF (D(I) <> INFINITY) AND ((MD = INFINITY) OR (D(I) < MD)) THEN MV = I
400     NEXT I
410     LET CV = MV * (MD <> INF)
420 NEXT CV : M$ = CHR$(13)
430 PRINT "SHORTEST PATH";
440 FOR I = 1 TO LEN(T$)
450     LET N$ = MID$(T$, I, 1)
460     PRINT M$ "    FROM " O$;
470     PRINT " TO "; : N = FN N(0)
480     IF D(N) = INFINITY THEN PRINT N$" DOES NOT EXIST.";
490     IF D(N) <> INFINITY THEN FOR N = N TO FALSE STEP 0 : PRINT CHR$(N + 64); : IF N <  > O THEN  PRINT " <- "; : N = PREVIOUS(N): NEXT N
500     IF D(N) <> INFINITY THEN PRINT : PRINT "      IS "; : N = FN N(0) : PRINT D(N); : H = 15 : FOR N = N TO O STEP 0: IF N <  > O THEN  P = PREVIOUS(N): PRINT TAB(H)CHR$(43+18*(h=15));TAB(H+2)PC(N); :N = P: H=H+5: NEXT N
510 NEXT I
600 DATA  7,A-B
610 DATA  9,A-C
620 DATA 14,A-F
630 DATA 10,B-C
640 DATA 15,B-D
650 DATA 11,C-D
660 DATA  2,C-F
670 DATA  6,D-E
680 DATA  9,E-F
690 DATA


define :graph [vertices, neighbours][]

initGraph: function [edges][
    vs: []
    ns: #[]
    loop edges 'e [
        [src, dst, cost]: e
        vs: sort unique append vs src
        vs: sort unique append vs dst
        if not? key? ns src -> ns\[src]: []

        ns\[src]: ns\[src] ++ @[@[dst, cost]]
    ]
    to :graph @[vs ns]
]

Inf: 1234567890

dijkstraPath: function [gr, fst, lst][
    dist: #[]
    prev: #[]
    result: new []
    notSeen: new gr\vertices
    loop gr\vertices 'vertex ->
        dist\[vertex]: Inf

    dist\[fst]: 0

    while [0 < size notSeen][
        vertex1: ""
        mindist: Inf
        loop notSeen 'vertex [
            if dist\[vertex] < mindist [
                vertex1: vertex
                mindist: dist\[vertex]
            ]
        ]
        if vertex1 = lst -> break
        'notSeen -- vertex1

        if key? gr\neighbours vertex1 [
            loop gr\neighbours\[vertex1] 'v [
                [vertex2, cost]: v

                if contains? notSeen vertex2 [
                    altdist: dist\[vertex1] + cost
                    if altdist < dist\[vertex2][
                        dist\[vertex2]: altdist
                        prev\[vertex2]: vertex1
                    ]
                ]
            ]
        ]
    ]

    vertex: lst
    while [not? empty? vertex][
        'result ++ vertex
        vertex: (key? prev vertex)? -> prev\[vertex] -> null
    ]
    reverse 'result
    return result
]

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

print ["Shortest path from 'a' to 'e': " join.with:" -> " dijkstraPath graph "a" "e"]
print ["Shortest path from 'a' to 'f': " join.with:" -> " dijkstraPath graph "a" "f"]


main( argv_ ) {
	if ( size( argv_ ) < 2 ) {
		throw Exception( "usage: digital-root {NUM}" );
	}
	n = argv_[1];
	if ( ( size( n ) == 0 ) || ( n.find_other_than( "0123456789" ) >= 0 ) ) {
		throw Exception( "{} is not a number".format( n ) );
	}
	shift = integer( '0' ) + 1;
	acc = 0;
	for ( d : n ) {
		acc = 1 + ( acc + integer( d ) - shift ) % 9;
	}
	print( "{}\n".format( acc ) );
	return ( 0 );
}


procedure main(A)
    every m := n := integer(!A) do {
       ap := 0
       while (*n > 1) do (ap +:= 1, n := sumdigits(n))
       write(m," has additive persistence of ",ap," and digital root of ",n)
       }
end

procedure sumdigits(n)
    s := 0
    n ? while s +:= move(1)
    return s
end


Dijkstra(data, start){
	nodes := [], dist := [], Distance := [], dist := [], prev := [], Q := [], min := "x"
	for each, line in StrSplit(data, "`n" , "`r")
		field := StrSplit(line,"`t"), nodes[field.1] := 1, nodes[field.2] := 1
		, Distance[field.1,field.2] := field.3, Distance[field.2,field.1] := field.3
	dist[start] := 0, prev[start] := ""

	for node in nodes {
		if (node <> start)
			dist[node] := "x"
			, prev[node] := ""
		Q[node] := 1
	}

	while % ObjCount(Q) {
		u := MinDist(Q, dist).2
		for node, val in Q
			if (node = u) {
				q.Remove(node)
				break
			}

		for v, length in Distance[u] {
			alt := dist[u] + length
			if (alt < dist[v])
				dist[v] := alt
				, prev[v] := u
		}
	}
	return [dist, prev]
}
;-----------------------------------------------
MinDist(Q, dist){
	for node , val in Q
		if A_Index=1
			min := dist[node], minNode := node
		else
			min := min < dist[node] ? min : dist[node]	, minNode := min < dist[node] ? minNode : node
	return [min,minNode]
}
ObjCount(Obj){
	for key, val in Obj
		count := A_Index
	return count
}


import java.math.BigInteger;

class DigitalRoot
{
  public static int[] calcDigitalRoot(String number, int base)
  {
    BigInteger bi = new BigInteger(number, base);
    int additivePersistence = 0;
    if (bi.signum() < 0)
      bi = bi.negate();
    BigInteger biBase = BigInteger.valueOf(base);
    while (bi.compareTo(biBase) >= 0)
    {
      number = bi.toString(base);
      bi = BigInteger.ZERO;
      for (int i = 0; i < number.length(); i++)
        bi = bi.add(new BigInteger(number.substring(i, i + 1), base));
      additivePersistence++;
    }
    return new int[] { additivePersistence, bi.intValue() };
  }

  public static void main(String[] args)
  {
    for (String arg : args)
    {
      int[] results = calcDigitalRoot(arg, 10);
      System.out.println(arg + " has additive persistence " + results[0] + " and digital root of " + results[1]);
    }
  }
}


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

typedef struct {
    int vertex;
    int weight;
} edge_t;

typedef struct {
    edge_t **edges;
    int edges_len;
    int edges_size;
    int dist;
    int prev;
    int visited;
} vertex_t;

typedef struct {
    vertex_t **vertices;
    int vertices_len;
    int vertices_size;
} graph_t;

typedef struct {
    int *data;
    int *prio;
    int *index;
    int len;
    int size;
} heap_t;

void add_vertex (graph_t *g, int i) {
    if (g->vertices_size < i + 1) {
        int size = g->vertices_size * 2 > i ? g->vertices_size * 2 : i + 4;
        g->vertices = realloc(g->vertices, size * sizeof (vertex_t *));
        for (int j = g->vertices_size; j < size; j++)
            g->vertices[j] = NULL;
        g->vertices_size = size;
    }
    if (!g->vertices[i]) {
        g->vertices[i] = calloc(1, sizeof (vertex_t));
        g->vertices_len++;
    }
}

void add_edge (graph_t *g, int a, int b, int w) {
    a = a - 'a';
    b = b - 'a';
    add_vertex(g, a);
    add_vertex(g, b);
    vertex_t *v = g->vertices[a];
    if (v->edges_len >= v->edges_size) {
        v->edges_size = v->edges_size ? v->edges_size * 2 : 4;
        v->edges = realloc(v->edges, v->edges_size * sizeof (edge_t *));
    }
    edge_t *e = calloc(1, sizeof (edge_t));
    e->vertex = b;
    e->weight = w;
    v->edges[v->edges_len++] = e;
}

heap_t *create_heap (int n) {
    heap_t *h = calloc(1, sizeof (heap_t));
    h->data = calloc(n + 1, sizeof (int));
    h->prio = calloc(n + 1, sizeof (int));
    h->index = calloc(n, sizeof (int));
    return h;
}

void push_heap (heap_t *h, int v, int p) {
    int i = h->index[v] == 0 ? ++h->len : h->index[v];
    int j = i / 2;
    while (i > 1) {
        if (h->prio[j] < p)
            break;
        h->data[i] = h->data[j];
        h->prio[i] = h->prio[j];
        h->index[h->data[i]] = i;
        i = j;
        j = j / 2;
    }
    h->data[i] = v;
    h->prio[i] = p;
    h->index[v] = i;
}

int min (heap_t *h, int i, int j, int k) {
    int m = i;
    if (j <= h->len && h->prio[j] < h->prio[m])
        m = j;
    if (k <= h->len && h->prio[k] < h->prio[m])
        m = k;
    return m;
}

int pop_heap (heap_t *h) {
    int v = h->data[1];
    int i = 1;
    while (1) {
        int j = min(h, h->len, 2 * i, 2 * i + 1);
        if (j == h->len)
            break;
        h->data[i] = h->data[j];
        h->prio[i] = h->prio[j];
        h->index[h->data[i]] = i;
        i = j;
    }
    h->data[i] = h->data[h->len];
    h->prio[i] = h->prio[h->len];
    h->index[h->data[i]] = i;
    h->len--;
    return v;
}

void dijkstra (graph_t *g, int a, int b) {
    int i, j;
    a = a - 'a';
    b = b - 'a';
    for (i = 0; i < g->vertices_len; i++) {
        vertex_t *v = g->vertices[i];
        v->dist = INT_MAX;
        v->prev = 0;
        v->visited = 0;
    }
    vertex_t *v = g->vertices[a];
    v->dist = 0;
    heap_t *h = create_heap(g->vertices_len);
    push_heap(h, a, v->dist);
    while (h->len) {
        i = pop_heap(h);
        if (i == b)
            break;
        v = g->vertices[i];
        v->visited = 1;
        for (j = 0; j < v->edges_len; j++) {
            edge_t *e = v->edges[j];
            vertex_t *u = g->vertices[e->vertex];
            if (!u->visited && v->dist + e->weight <= u->dist) {
                u->prev = i;
                u->dist = v->dist + e->weight;
                push_heap(h, e->vertex, u->dist);
            }
        }
    }
}

void print_path (graph_t *g, int i) {
    int n, j;
    vertex_t *v, *u;
    i = i - 'a';
    v = g->vertices[i];
    if (v->dist == INT_MAX) {
        printf("no path\n");
        return;
    }
    for (n = 1, u = v; u->dist; u = g->vertices[u->prev], n++)
        ;
    char *path = malloc(n);
    path[n - 1] = 'a' + i;
    for (j = 0, u = v; u->dist; u = g->vertices[u->prev], j++)
        path[n - j - 2] = 'a' + u->prev;
    printf("%d %.*s\n", v->dist, n, path);
}

int main () {
    graph_t *g = calloc(1, sizeof (graph_t));
    add_edge(g, 'a', 'b', 7);
    add_edge(g, 'a', 'c', 9);
    add_edge(g, 'a', 'f', 14);
    add_edge(g, 'b', 'c', 10);
    add_edge(g, 'b', 'd', 15);
    add_edge(g, 'c', 'd', 11);
    add_edge(g, 'c', 'f', 2);
    add_edge(g, 'd', 'e', 6);
    add_edge(g, 'e', 'f', 9);
    dijkstra(g, 'a', 'e');
    print_path(g, 'e');
    return 0;
}


/// Digital root of 'x' in base 'b'.
/// @return {addpers, digrt}
function digitalRootBase(x,b) {
   if (x < b)
      return {addpers:0, digrt:x};

   var fauxroot = 0;
   while (b <= x) {
      x = (x / b) | 0;
      fauxroot += x % b;
   }

   var rootobj = digitalRootBase(fauxroot,b);
   rootobj.addpers += 1;
   return rootobj;
}


def do_until(condition; next):
  def u: if condition then . else (next|u) end;
  u;

# n may be a decimal number or a string representing a decimal number
def digital_root(n):
  # string-only version
  def dr:
    # state: [mdr, persist]
    do_until( .[0] | length == 1;
              [ (.[0] | explode | map(.-48) | add | tostring), .[1] + 1 ]
              );
  [n|tostring, 0] | dr | .[0] |= tonumber;

def neatly:
  . as $in
  | range(0;length)
  | "\(.): \($in[.])";

def rjust(n): tostring | (n-length)*" " + .;


function digitalroot(n::Integer, bs::Integer=10)
    if n < 0 || bs < 2 throw(DomainError()) end
    ds, pers = n, 0
    while bs ≤ ds
        ds = sum(digits(ds, bs))
        pers += 1
    end
    return pers, ds
end

for i in [627615, 39390, 588225, 393900588225, big(2) ^ 100]
    pers, ds = digitalroot(i)
    println(i, " has persistence ", pers, " and digital root ", ds)
end


using static System.Linq.Enumerable;
using static System.String;
using static System.Console;
using System.Collections.Generic;
using System;
using EdgeList = System.Collections.Generic.List<(int node, double weight)>;

public static class Dijkstra
{
    public static void Main() {
        Graph graph = new Graph(6);
        Func<char, int> id = c => c - 'a';
        Func<int , char> name = i => (char)(i + 'a');
        foreach (var (start, end, cost) in new [] {
            ('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),
        }) {
            graph.AddEdge(id(start), id(end), cost);
        }

        var path = graph.FindPath(id('a'));
        for (int d = id('b'); d <= id('f'); d++) {
            WriteLine(Join(" -> ", Path(id('a'), d).Select(p => $"{name(p.node)}({p.distance})").Reverse()));
        }

        IEnumerable<(double distance, int node)> Path(int start, int destination) {
            yield return (path[destination].distance, destination);
            for (int i = destination; i != start; i = path[i].prev) {
                yield return (path[path[i].prev].distance, path[i].prev);
            }
        }
    }

}

sealed class Graph
{
    private readonly List<EdgeList> adjacency;

    public Graph(int vertexCount) => adjacency = Range(0, vertexCount).Select(v => new EdgeList()).ToList();

    public int Count => adjacency.Count;
    public bool HasEdge(int s, int e) => adjacency[s].Any(p => p.node == e);
    public bool RemoveEdge(int s, int e) => adjacency[s].RemoveAll(p => p.node == e) > 0;

    public bool AddEdge(int s, int e, double weight) {
        if (HasEdge(s, e)) return false;
        adjacency[s].Add((e, weight));
        return true;
    }

    public (double distance, int prev)[] FindPath(int start) {
        var info = Range(0, adjacency.Count).Select(i => (distance: double.PositiveInfinity, prev: i)).ToArray();
        info[start].distance = 0;
        var visited = new System.Collections.BitArray(adjacency.Count);

        var heap = new Heap<(int node, double distance)>((a, b) => a.distance.CompareTo(b.distance));
        heap.Push((start, 0));
        while (heap.Count > 0) {
            var current = heap.Pop();
            if (visited[current.node]) continue;
            var edges = adjacency[current.node];
            for (int n = 0; n < edges.Count; n++) {
                int v = edges[n].node;
                if (visited[v]) continue;
                double alt = info[current.node].distance + edges[n].weight;
                if (alt < info[v].distance) {
                    info[v] = (alt, current.node);
                    heap.Push((v, alt));
                }
            }
            visited[current.node] = true;
        }
        return info;
    }

}

sealed class Heap<T>
{
    private readonly IComparer<T> comparer;
    private readonly List<T> list = new List<T> { default };

    public Heap() : this(default(IComparer<T>)) { }

    public Heap(IComparer<T> comparer) {
        this.comparer = comparer ?? Comparer<T>.Default;
    }

    public Heap(Comparison<T> comparison) : this(Comparer<T>.Create(comparison)) { }

    public int Count => list.Count - 1;

    public void Push(T element) {
        list.Add(element);
        SiftUp(list.Count - 1);
    }

    public T Pop() {
        T result = list[1];
        list[1] = list[list.Count - 1];
        list.RemoveAt(list.Count - 1);
        SiftDown(1);
        return result;
    }

    private static int Parent(int i) => i / 2;
    private static int Left(int i) => i * 2;
    private static int Right(int i) => i * 2 + 1;

    private void SiftUp(int i) {
        while (i > 1) {
            int parent = Parent(i);
            if (comparer.Compare(list[i], list[parent]) > 0) return;
            (list[parent], list[i]) = (list[i], list[parent]);
            i = parent;
        }
    }

    private void SiftDown(int i) {
        for (int left = Left(i); left < list.Count; left = Left(i)) {
            int smallest = comparer.Compare(list[left], list[i]) <= 0 ? left : i;
            int right = Right(i);
            if (right < list.Count && comparer.Compare(list[right], list[smallest]) <= 0) smallest = right;
            if (smallest == i) return;
            (list[i], list[smallest]) = (list[smallest], list[i]);
            i = smallest;
        }
    }

}


/ print digital root and additive persistence
prt: {`"Digital root = ", x, `"Additive persistence = ",y}
/ sum of digits of an integer
sumdig: {d::(); (0<){d::d,x!10; x%:10}/x; +/d}
/ compute digital root and additive persistence
digroot: {sm::sumdig x; ap::0; (9<){sm::sumdig x;ap::ap+1; x:sm}/x; prt[sm;ap]}


// version 1.0.6

fun sumDigits(n: Long): Int = when {
        n < 0L -> throw IllegalArgumentException("Negative numbers not allowed")
        else   -> {
            var sum = 0
            var nn  = n
            while (nn > 0L) {
                sum += (nn % 10).toInt()
                nn /= 10
            }
            sum
        }
    }

fun digitalRoot(n: Long): Pair<Int, Int> = when {
        n < 0L  -> throw IllegalArgumentException("Negative numbers not allowed")
        n < 10L -> Pair(n.toInt(), 0)
        else    -> {
            var dr = n
            var ap = 0
            while (dr > 9L) {
                dr = sumDigits(dr).toLong()
                ap++
            }
            Pair(dr.toInt(), ap)
        }
    }

fun main(args: Array<String>) {
    val a = longArrayOf(1, 14, 267, 8128, 627615, 39390, 588225, 393900588225)
    for (n in a) {
        val(dr, ap) = digitalRoot(n)
        println("${n.toString().padEnd(12)} has additive persistence $ap and digital root of $dr")
    }
}


#include <iostream>
#include <vector>
#include <string>
#include <list>

#include <limits> // for numeric_limits

#include <set>
#include <utility> // for pair
#include <algorithm>
#include <iterator>

typedef int vertex_t;
typedef double weight_t;

const weight_t max_weight = std::numeric_limits<double>::infinity();

struct neighbor {
    vertex_t target;
    weight_t weight;
    neighbor(vertex_t arg_target, weight_t arg_weight)
        : target(arg_target), weight(arg_weight) { }
};

typedef std::vector<std::vector<neighbor> > adjacency_list_t;

void DijkstraComputePaths(vertex_t source,
                          const adjacency_list_t &adjacency_list,
                          std::vector<weight_t> &min_distance,
                          std::vector<vertex_t> &previous)
{
    int n = adjacency_list.size();
    min_distance.clear();
    min_distance.resize(n, max_weight);
    min_distance[source] = 0;
    previous.clear();
    previous.resize(n, -1);
    std::set<std::pair<weight_t, vertex_t> > vertex_queue;
    vertex_queue.insert(std::make_pair(min_distance[source], source));

    while (!vertex_queue.empty())
    {
        weight_t dist = vertex_queue.begin()->first;
        vertex_t u = vertex_queue.begin()->second;
        vertex_queue.erase(vertex_queue.begin());

        // Visit each edge exiting u
	const std::vector<neighbor> &neighbors = adjacency_list[u];
        for (std::vector<neighbor>::const_iterator neighbor_iter = neighbors.begin();
             neighbor_iter != neighbors.end();
             neighbor_iter++)
        {
            vertex_t v = neighbor_iter->target;
            weight_t weight = neighbor_iter->weight;
            weight_t distance_through_u = dist + weight;
	    if (distance_through_u < min_distance[v]) {
	        vertex_queue.erase(std::make_pair(min_distance[v], v));

	        min_distance[v] = distance_through_u;
	        previous[v] = u;
	        vertex_queue.insert(std::make_pair(min_distance[v], v));

	    }

        }
    }
}

std::list<vertex_t> DijkstraGetShortestPathTo(
    vertex_t vertex, const std::vector<vertex_t> &previous)
{
    std::list<vertex_t> path;
    for ( ; vertex != -1; vertex = previous[vertex])
        path.push_front(vertex);
    return path;
}

int main()
{
    // remember to insert edges both ways for an undirected graph
    adjacency_list_t adjacency_list(6);
    // 0 = a
    adjacency_list[0].push_back(neighbor(1, 7));
    adjacency_list[0].push_back(neighbor(2, 9));
    adjacency_list[0].push_back(neighbor(5, 14));
    // 1 = b
    adjacency_list[1].push_back(neighbor(0, 7));
    adjacency_list[1].push_back(neighbor(2, 10));
    adjacency_list[1].push_back(neighbor(3, 15));
    // 2 = c
    adjacency_list[2].push_back(neighbor(0, 9));
    adjacency_list[2].push_back(neighbor(1, 10));
    adjacency_list[2].push_back(neighbor(3, 11));
    adjacency_list[2].push_back(neighbor(5, 2));
    // 3 = d
    adjacency_list[3].push_back(neighbor(1, 15));
    adjacency_list[3].push_back(neighbor(2, 11));
    adjacency_list[3].push_back(neighbor(4, 6));
    // 4 = e
    adjacency_list[4].push_back(neighbor(3, 6));
    adjacency_list[4].push_back(neighbor(5, 9));
    // 5 = f
    adjacency_list[5].push_back(neighbor(0, 14));
    adjacency_list[5].push_back(neighbor(2, 2));
    adjacency_list[5].push_back(neighbor(4, 9));

    std::vector<weight_t> min_distance;
    std::vector<vertex_t> previous;
    DijkstraComputePaths(0, adjacency_list, min_distance, previous);
    std::cout << "Distance from 0 to 4: " << min_distance[4] << std::endl;
    std::list<vertex_t> path = DijkstraGetShortestPathTo(4, previous);
    std::cout << "Path : ";
    std::copy(path.begin(), path.end(), std::ostream_iterator<vertex_t>(std::cout, " "));
    std::cout << std::endl;

    return 0;
}


function digital_root(n, base)
    p = 0
    while n > 9.5 do
        n = sum_digits(n, base)
        p = p + 1
    end
    return n, p
end

print(digital_root(627615, 10))
print(digital_root(39390, 10))
print(digital_root(588225, 10))
print(digital_root(393900588225, 10))


            NORMAL MODE IS INTEGER
            VECTOR VALUES INP  = $I12*$
            VECTOR VALUES OUTP = $I12,S1,I12*$
            BASE = 10

          R READ NUMBERS UNTIL 0 INPUT
RDNUM       READ FORMAT INP,NUMBER
            WHENEVER NUMBER.NE.0
SUMMAT          PERS = 0
                DSUM = 0

          R     CALCULATE ROOT AND PERSISTENCE
DIGIT           DSUM = DSUM + NUMBER-NUMBER/BASE*BASE
                NUMBER = NUMBER/BASE
                PERS = PERS + 1
                WHENEVER NUMBER.NE.0, TRANSFER TO DIGIT
                NUMBER = DSUM
                WHENEVER NUMBER.GE.10, TRANSFER TO SUMMAT

                PRINT FORMAT OUTP,DSUM,PERS
                TRANSFER TO RDNUM
            END OF CONDITIONAL
            END OF PROGRAM


seq[n_, b_] := FixedPointList[Total[IntegerDigits[#, b]] &, n];
root[n_Integer, base_: 10] := If[base == 10, #, BaseForm[#, base]] &[Last[seq[n, base]]]
persistance[n_Integer, base_: 10] := Length[seq[n, base]] - 2;


(declare neighbours
         process-neighbour
         prepare-costs
         get-next-node
         unwind-path
         all-shortest-paths)

;; Main algorithm

(defn dijkstra
  "Given two nodes A and B, and graph, finds shortest path from point A to point B.
  Given one node and graph, finds all shortest paths to all other nodes.

  Graph example: {1 {2 7 3 9 6 14}
                  2 {1 7 3 10 4 15}
                  3 {1 9 2 10 4 11 6 2}
                  4 {2 15 3 11 5 6}
                  5 {6 9 4 6}
                  6 {1 14 3 2 5 9}}
                  ^  ^  ^
                  |  |  |
         node label  |  |
    neighbour label---  |
          edge cost------
  From example in Wikipedia: https://en.wikipedia.org/wiki/Dijkstra's_algorithm

  Output example: [20 [1 3 6 5]]
                   ^  ^
                   |  |
  shortest path cost  |
       shortest path---"
  ([a b graph]
   (loop [costs (prepare-costs a graph)
          unvisited (set (keys graph))]
     (let [current-node (get-next-node costs unvisited)
           current-cost (first (costs current-node))]
       (cond (nil? current-node)
             (all-shortest-paths a costs)

             (= current-node b)
             [current-cost (unwind-path a b costs)]

             :else
             (recur (reduce (partial process-neighbour
                                     current-node
                                     current-cost)
                            costs
                            (filter (comp unvisited first)
                                    (neighbours current-node graph costs)))
                    (disj unvisited current-node))))))
  ([a graph] (dijkstra a nil graph)))

;; Implementation details

(defn prepare-costs
  "For given start node A ang graph prepare map of costs to start with
  (assign maximum value for all nodes and zero for starting one).
  Also save info about most advantageous parent.
  Example output: {2 [2147483647 7], 6 [2147483647 14]}
                   ^   ^         ^
                   |   |         |
                node   |         |
               cost-----         |
             parent---------------"
  [start graph]
  (assoc (zipmap (keys graph)
                 (repeat [Integer/MAX_VALUE nil]))
         start [0 start]))

(defn neighbours
  "Get given node's neighbours along with their own costs and costs of corresponding edges.
  Example output is: {1 [7 10] 2 [4 15]}
                      ^  ^  ^
                      |  |  |
   neighbour node label  |  |
        neighbour cost ---  |
             edge cost ------"
  [node graph costs]
  (->> (graph node)
       (map (fn [[neighbour edge-cost]]
              [neighbour [(first (costs neighbour)) edge-cost]]))
       (into {})))

(defn process-neighbour
  [parent
   parent-cost
   costs
   [neighbour [old-cost edge-cost]]]
  (let [new-cost (+ parent-cost edge-cost)]
    (if (< new-cost old-cost)
      (assoc costs
             neighbour
             [new-cost parent])
      costs)))

(defn get-next-node [costs unvisited]
  (->> costs
       (filter (comp unvisited first))
       (sort-by (comp first second))
       ffirst))

(defn unwind-path
  "Restore path from A to B based on costs data"
  [a b costs]
  (letfn [(f [a b costs]
            (when-not (= a b)
              (cons b (f a (second (costs b)) costs))))]
    (cons a (reverse (f a b costs)))))

(defn all-shortest-paths
  "Get shortest paths for all nodes, along with their costs"
  [start costs]
  (let [paths (->> (keys costs)
                   (remove #{start})
                   (map (fn [n] [n (unwind-path start n costs)])))]
    (into (hash-map)
          (map (fn [[n p]]
                 [n [(first (costs n)) p]])
               paths))))

;; Utils

(require '[clojure.pprint :refer [print-table]])

(defn print-solution [solution]
  (print-table
   (map (fn [[node [cost path]]]
          {'node node 'cost cost 'path path})
        solution)))

;; Solutions

;; Task 1. Implement a version of Dijkstra's algorithm that outputs a set of edges depicting the shortest path to each reachable node from an origin.

;; see above

;; Task 2. Run your program with the following directed graph starting at node a.

;; Edges
;;   Start    End  Cost
;;   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

(def rosetta-graph
  '{a {b 7 c 9 f 14}
    b {c 10 d 15}
    c {d 11 f 2}
    d {e 6}
    e {f 9}
    f {}})

(def task-2-solution
  (dijkstra 'a rosetta-graph))

(print-solution task-2-solution)

;; Output:
;; | node | cost |      path |
;; |------+------+-----------|
;; |    b |    7 |     (a b) |
;; |    c |    9 |     (a c) |
;; |    d |   20 |   (a c d) |
;; |    e |   26 | (a c d e) |
;; |    f |   11 |   (a c f) |

;; Task 3. Write a program which interprets the output from the above and use it to output the shortest path from node a to nodes e and f

(print-solution (select-keys task-2-solution '[e f]))

;; Output:
;; | node | cost |      path |
;; |------+------+-----------|
;; |    e |   26 | (a c d e) |
;; |    f |   11 |   (a c f) |


MODULE DigitalRoot;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,WriteLn,ReadChar;

TYPE Root =
    RECORD
        persistence,root : LONGINT;
    END;

PROCEDURE digitalRoot(inRoot,base : LONGINT) : Root;
VAR root,persistence,num : LONGINT;
BEGIN
    root := ABS(inRoot);
    persistence := 0;
    WHILE root>=base DO
        num := root;
        root := 0;
        WHILE num#0 DO
            root := root + (num MOD base);
            num := num DIV base;
        END;
        INC(persistence)
    END;
    RETURN Root{persistence, root}
END digitalRoot;

PROCEDURE Print(n,b : LONGINT);
VAR
    buf : ARRAY[0..63] OF CHAR;
    r : Root;
BEGIN
    r := digitalRoot(n,b);
    FormatString("%u (base %u): persistence=%u, digital root=%u\n", buf, n, b, r.persistence, r.root);
    WriteString(buf)
END Print;

VAR
    buf : ARRAY[0..63] OF CHAR;
    b,n : LONGINT;
    r : Root;
BEGIN
    Print(1,10);
    Print(14,10);
    Print(267,10);
    Print(8128,10);
    Print(39390,10);
    Print(627615,10);
    Print(588225,10);

    ReadChar
END DigitalRoot.


100 NV=0: REM NUMBER OF VERTICES
110 READ N$:IF N$<>"" THEN NV=NV+1:GOTO 110
120 NE=0: REM NUMBER OF EDGES
130 READ N1:IF N1 >= 0 THEN READ N2,W:NE=NE+1:GOTO 130
140 DIM VN$(NV-1),VD(NV-1,2): REM VERTEX NAMES AND DATA
150 DIM ED(NE-1,2): REM EDGE DATA
160 RESTORE
170 FOR I=0 TO NV-1
180 : READ VN$(I):  REM VERTEX NAME
190 : VD(I,0) = -1: REM DISTANCE = INFINITY
200 : VD(I,1) = 0:  REM NOT YET VISITED
210 : VD(I,2) = -1: REM NO PREV VERTEX YET
220 NEXT I
230 READ N$: REM SKIP SENTINEL
240 FOR I=0 TO NE-1
250 : READ ED(I,0),ED(I,1),ED(I,2): REM EDGE FROM, TO, WEIGHT
260 NEXT I
270 READ N1: REM SKIP SENTINEL
280 READ O: REM ORIGIN VERTEX
290 :
300 REM BEGIN DIJKSTRA'S
310 VD(O,0) = 0: REM DISTANCE TO ORIGIN IS 0
320 CV = 0: REM CURRENT VERTEX IS ORIGIN
330 FOR I=0 TO NE-1
340 : IF ED(I,0)<>CV THEN 390: REM SKIP EDGES NOT FROM CURRENT
350 : N=ED(I,1): REM NEIGHBOR VERTEX
360 : D=VD(CV,0) + ED(I,2): REM TOTAL DISTANCE TO NEIGHBOR THROUGH THIS PATH
370 : REM IF PATH THRU CV < DISTANCE, UPDATE DISTANCE AND PREV VERTEX
380 : IF (VD(N,0)=-1) OR (D<VD(N,0)) THEN VD(N,0) = D:VD(N,2)=CV
390 NEXT I
400 VD(CV,1)=1: REM CURRENT VERTEX HAS BEEN VISITED
410 MV=-1: REM VERTEX WITH MINIMUM DISTANCE SEEN
420 FOR I=0 TO NV-1
430 : IF VD(I,1) THEN 470: REM SKIP VISITED VERTICES
440 : REM IF THIS IS THE SMALLEST DISTANCE SEEN, REMEMBER IT
450 : MD=-1:IF MV > -1 THEN MD=VD(MV,0)
460 : IF ( VD(I,0)<>-1 ) AND ( ( MD=-1 ) OR ( VD(I,0)<MD ) ) THEN MV=I
470 NEXT I
480 IF MD=-1 THEN 510: REM END IF ALL VERTICES VISITED OR AT INFINITY
490 CV=MV
500 GOTO 330
510 PRINT "SHORTEST PATH TO EACH VERTEX FROM "VN$(O)":";CHR$(13)
520 FOR I=0 TO NV-1
530 : IF I=0 THEN 600
540 : PRINT VN$(I)":"VD(I,0)"(";
550 : IF VD(I,0)=-1 THEN 600
560 : N=I
570 : PRINT VN$(N);
580 : IF N<>O THEN PRINT "←";:N=VD(N,2):GOTO 570
590 : PRINT ")"
600 NEXT I
610 DATA A,B,C,D,E,F,""
620 DATA 0,1,7
630 DATA 0,2,9
640 DATA 0,5,14
650 DATA 1,2,10
660 DATA 1,3,15
670 DATA 2,3,11
680 DATA 2,5,2
690 DATA 3,4,6
700 DATA 4,5,9
710 DATA -1
720 DATA 0


(defparameter *w* '((a (a b . 7) (a c . 9) (a f . 14))
                    (b (b c . 10) (b d . 15))
                    (c (c d . 11) (c f . 2))
                    (d (d e . 6))
                    (e (e f . 9))))

(defvar *r* nil)

(defun dijkstra-short-path (i g)
  (setf *r* nil) (paths i g 0 `(,i))
  (car (sort *r* #'< :key #'cadr)))

(defun paths (c g z v)
  (if (eql c g) (push `(,(reverse v) ,z) *r*)
      (loop for a in (nodes c) for b = (cadr a) do
            (unless (member b v)
              (paths b g (+ (cddr a) z) (cons b v))))))

(defun nodes (c)
  (sort (cdr (assoc c *w*)) #'< :key #'cddr))


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

println "here"

if main
	values = {627615, 39390, 588825, 393900588225, 55}
	for n in values
		aproot = digital_root(n)
		println format("%12d has additive persistence %2d and digital root %d.", n, aproot[0], aproot[1])
	end
end


/* NetRexx ************************************************************
* Test digroot
**********************************************************************/
Say 'number -> digital_root persistence'
test_digroot(7           ,7, 0)
test_digroot(627615      ,9, 2)
test_digroot(39390       ,6, 2)
test_digroot(588225      ,3, 2)
test_digroot(393900588225,9, 2)
test_digroot(393900588225,9, 3)   /* test error case */

method test_digroot(n,dx,px) static
res=digroot(n)
Parse res d p
If d=dx & p=px Then tag='ok'
               Else tag='expected:' dx px
Say n '->' d p tag

method digroot(n) static
/**********************************************************************
* Compute the digital root and persistence of the given decimal number
* 19.08.2012 Walter Pachl derived from Rexx
**************************** Bottom of Data **************************/
p=0                                 /* persistence                   */
Loop While n.length()>1             /* more than one digit in n      */
  s=0                               /* initialize sum                */
  p=p+1                             /* increment persistence         */
  Loop while n<>''                  /* as long as there are digits   */
    Parse n c +1 n                  /* pick the first one            */
    s=s+c                           /* add to the new sum            */
    End
  n=s                               /* the 'new' number              */
  End
return n p                          /* return root and persistence   */


import strutils

proc droot(n: int64): auto =
  var x = @[n]
  while x[x.high] > 10:
    var s = 0'i64
    for dig in $x[x.high]:
      s += parseInt("" & dig)
    x.add s
  return (x.len - 1, x[x.high])

for n in [627615'i64, 39390'i64, 588225'i64, 393900588225'i64]:
  let (a, d) = droot(n)
  echo align($n, 12)," has additive persistence ",a," and digital root of ",d


import std.stdio, std.typecons, std.algorithm, std.container;

alias Vertex = string;
alias Weight = int;

struct Neighbor {
    Vertex target;
    Weight weight;
}

alias AdjacencyMap = Neighbor[][Vertex];

pure dijkstraComputePaths(Vertex source, Vertex target, AdjacencyMap adjacencyMap){
    Weight[Vertex] minDistance;
    Vertex[Vertex] previous;

    foreach(v, neighs; adjacencyMap){
        minDistance[v] = Weight.max;
        foreach(n; neighs) minDistance[n.target] = Weight.max;
    }

    minDistance[source] = 0;
    auto vertexQueue = redBlackTree(tuple(minDistance[source], source));

    foreach(_, u; vertexQueue){
        if (u == target)
            break;

        // Visit each edge exiting u.
        foreach(n; adjacencyMap.get(u, null)){
            const v = n.target;
            const distanceThroughU = minDistance[u] + n.weight;
            if(distanceThroughU < minDistance[v]){
                vertexQueue.removeKey(tuple(minDistance[v], v));
                minDistance[v] = distanceThroughU;
                previous[v] = u;
                vertexQueue.insert(tuple(minDistance[v], v));
            }
        }
    }

    return tuple(minDistance, previous);
}

pure dijkstraGetShortestPathTo(Vertex v, Vertex[Vertex] previous){
    Vertex[] path = [v];

    while (v in previous) {
        v = previous[v];
        if (v == path[$ - 1])
            break;
        path ~= v;
    }

    path.reverse();
    return path;
}

void main() {
    immutable arcs = [tuple("a", "b", 7),
                      tuple("a", "c", 9),
                      tuple("a", "f", 14),
                      tuple("b", "c", 10),
                      tuple("b", "d", 15),
                      tuple("c", "d", 11),
                      tuple("c", "f", 2),
                      tuple("d", "e", 6),
                      tuple("e", "f", 9)];

    AdjacencyMap adj;
    foreach (immutable arc; arcs) {
        adj[arc[0]] ~= Neighbor(arc[1], arc[2]);
        // Add this if you want an undirected graph:
        //adj[arc[1]] ~= Neighbor(arc[0], arc[2]);
    }

    const minDist_prev = dijkstraComputePaths("a", "e", adj);
    const minDistance = minDist_prev[0];
    const previous = minDist_prev[1];

    writeln(`Distance from "a" to "e": `, minDistance["e"]);
    writeln("Path: ", dijkstraGetShortestPathTo("e", previous));
}


: sumDigits(n, base)  0 while(n) [ n base /mod ->n + ] ;

: digitalRoot(n, base)
   0 while(n 9 >) [ 1 + sumDigits(n, base) ->n ] n swap Pair new ;


(define (digital-root num)
   (if (less? num 10)
      num
      (let loop ((num num) (sum 0))
         (if (zero? num)
            (digital-root sum)
            (loop (div num 10) (+ sum (mod num 10)))))))

(print (digital-root 627615))
(print (digital-root 39390))
(print (digital-root 588225))
(print (digital-root 393900588225))


dsum(n)=my(s); while(n, s+=n%10; n\=10); s
additivePersistence(n)=my(s); while(n>9, s++; n=dsum(n)); s
digitalRoot(n)=if(n, (n-1)%9+1, 0)


program Rosetta_Dijkstra_Console;

{$APPTYPE CONSOLE}

uses SysUtils; // for printing the result

// Conventional values (any negative values would do)
const
  INFINITY  = -1;
  NO_VERTEX = -2;

const
  NR_VERTICES = 6;

// DISTANCE_MATRIX[u, v] = length of directed edge from u to v, or -1 if no such edge exists.
// A simple way to represent a directed graph with not many vertices.
const DISTANCE_MATRIX : array [0..(NR_VERTICES - 1), 0..(NR_VERTICES - 1)] of integer
= ((-1,  7,  9, -1, -1, -1),
   (-1, -1, 10, 15, -1, -1),
   (-1, -1, -1, 11, -1,  2),
   (-1, -1, -1, -1,  6, -1),
   (-1, -1, -1, -1, -1,  9),
   (-1, -1, -1, -1, -1, -1));

type TVertex = record
  Distance : integer; // distance from vertex 0; infinity if a path has not yet been found
  Previous : integer; // previous vertex in the path from vertex 0
  Visited  : boolean; // as defined in the algorithm
end;

// For distances x and y, test whether x < y, using the convention that -1 means infinity.
function IsLess( x, y : integer) : boolean;
begin
  result := (x <> INFINITY)
        and ( (y = INFINITY) or (x < y) );
end;

// Main routine
var
  v : array [0..NR_VERTICES - 1] of TVertex; // array of vertices
  c : integer; // index of current vertex
  j : integer; // loop counter
  trialDistance : integer;
  minDistance : integer;
  // Variables for printing the result
  p : integer;
  lineOut : string;
begin
  // Initialize the vertices
  for j := 0 to NR_VERTICES - 1 do begin
    v[j].Distance := INFINITY;
    v[j].Previous := NO_VERTEX;
    v[j].Visited  := false;
  end;

  // Start with vertex 0 as the current vertex
  c := 0;
  v[c].Distance := 0;

  // Main loop of Dijkstra's algorithm
  repeat

    // Work through unvisited neighbours of the current vertex, updating them where possible.
    // "Neighbour" means the end of a directed edge from the current vertex.
    // Note that v[c].Distance is always finite.
    for j := 0 to NR_VERTICES - 1 do begin
      if (not v[j].Visited) and (DISTANCE_MATRIX[c, j] >= 0) then begin
        trialDistance := v[c].Distance + DISTANCE_MATRIX[c, j];
        if IsLess( trialDistance, v[j].Distance) then begin
          v[j].Distance := trialDistance;
          v[j].Previous := c;
        end;
      end;
    end;

    // When all neighbours have been tested, mark the current vertex as visited.
    v[c].Visited := true;

    // The new current vertex is the unvisited vertex with the smallest finite distance.
    // If there is no such vertex, the algorithm is finished.
    c := NO_VERTEX;
    minDistance := INFINITY;
    for j := 0 to NR_VERTICES - 1 do begin
      if (not v[j].Visited) and IsLess( v[j].Distance, minDistance) then begin
        minDistance := v[j].Distance;
        c := j;
      end;
    end;
  until (c = NO_VERTEX);

  // Print the result
  for j := 0 to NR_VERTICES - 1 do begin
    if (v[j].Distance = INFINITY) then begin
      // The algorithm never found a path to v[j]
      lineOut := SysUtils.Format( '%2d: inaccessible', [j]);
    end
    else begin
      // Build up the path of vertices, working backwards from v[j]
      lineOut := SysUtils.Format( '%2d', [j]);
      p := v[j].Previous;
      while (p <> NO_VERTEX) do begin
        lineOut := SysUtils.Format( '%2d --> ', [p]) + lineOut;
        p := v[p].Previous;
      end;
      // Print the path of vertices, preceded by distance from vertex 0
      lineOut := SysUtils.Format( '%2d: distance = %3d, ', [j, v[j].Distance]) + lineOut;
    end;
    WriteLn( lineOut);
  end;
end.


program DigitalRoot;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  SysUtils, StrUtils;

// FPC has no Big mumbers implementation, Int64 will suffice.

procedure GetDigitalRoot(Value: Int64; Base: Byte; var DRoot, Pers: Integer);
var
  i: Integer;
  DigitSum: Int64;
begin
  Pers := 0;
  repeat
    Inc(Pers);
    DigitSum := 0;
    while Value > 0 do
    begin
      Inc(DigitSum, Value mod Base);
      Value := Value div Base;
    end;
    Value := DigitSum;
  until Value < Base;
  DRoot := Value;
End;

function IntToStrBase(Value: Int64; Base: Byte):String;
const
  // usable up to 36-Base
  DigitSymbols = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXY';
begin
  Result := '';
  while Value > 0 do
  begin
    Result := DigitSymbols[Value mod Base+1] + Result;
    Value := Value div Base;
  End;

End;

procedure Display(const Value: Int64; Base: Byte = 10);
var
  DRoot, Pers: Integer;
  StrValue: string;
begin
  GetDigitalRoot(Value, Base, DRoot, Pers);
  WriteLn(Format('%s(%d) has additive persistence %d and digital root %d.',
    [IntToStrBase(Value, Base), Base, Pers, DRoot]));
End;

begin
  WriteLn('--- Examples in 10-Base ---');
  Display(627615);
  Display(39390);
  Display(588225);
  Display(393900588225);

  WriteLn('--- Examples in 16-Base ---');
  Display(627615, 16);
  Display(39390, 16);
  Display(588225, 16);
  Display(393900588225, 16);

  ReadLn;
End.


-module(dijkstra).
-include_lib("eunit/include/eunit.hrl").
-export([dijkstrafy/3]).

% just hide away recursion so we have a nice interface
dijkstrafy(Graph, Start, End) when is_map(Graph) ->
	shortest_path(Graph, [{0, [Start]}], End, #{}).

shortest_path(_Graph, [], _End, _Visited) ->
	% if we're not going anywhere, it's time to start going back
	{0, []};
shortest_path(_Graph, [{Cost, [End | _] = Path} | _ ], End, _Visited) ->
	% this is the base case, and finally returns the distance and the path
	{Cost, lists:reverse(Path)};
shortest_path(Graph, [{Cost, [Node | _ ] = Path} | Routes], End, Visited) ->
	% this is the recursive case.
	% here we build a list of new "unvisited" routes, where the stucture is
	% a tuple of cost, then a list of paths taken to get to that cost from the "Start"
	NewRoutes = [{Cost + NewCost, [NewNode | Path]}
		|| {NewCost, NewNode} <- maps:get(Node, Graph),
			not maps:get(NewNode, Visited, false)],
	shortest_path(
		Graph,
		% add the routes we ripped off earlier onto the new routes
		% that we want to visit. sort the list of routes to get the
		% shortest routes (lowest cost) at the beginning.
		% Erlangs sort is already good enough, and it will sort the
		% tuples by the number at the beginning of each (the cost).
		lists:sort(NewRoutes ++ Routes),
		End,
		Visited#{Node => true}
	).

basic_test() ->
	Graph = #{
		a => [{7,b},{9,c},{14,f}],
		b => [{7,a},{10,c},{15,d}],
		c => [{10,b},{9,c},{11,d},{2,f}],
		d => [{15,b},{6,e},{11,c}],
		e => [{9,f},{6,d}],
		f => [{14,f},{2,c},{9,e}]
	},
	{Cost, Path}   = dijkstrafy(Graph, a, e),
	{20,[a,c,f,e]} = {Cost, Path},
	io:format(user, "The total cost was ~p and the path was: ", [Cost]),
	io:format(user, "~w~n", [Path]).


#!perl
use strict;
use warnings;
use List::Util qw(sum);

my @digit = (0..9, 'a'..'z');
my %digit = map { +$digit[$_], $_ } 0 .. $#digit;

sub base {
   my ($n, $b) = @_;
   $b ||= 10;
   die if $b > @digit;
   my $result = '';
   while( $n ) {
      $result .= $digit[ $n % $b ];
      $n = int( $n / $b );
   }
   reverse($result) || '0';
}

sub digi_root {
   my ($n, $b) = @_;
   my $inbase = base($n, $b);
   my $additive_persistance = 0;
   while( length($inbase) > 1 ) {
      ++$additive_persistance;
      $n = sum @digit{split //, $inbase};
      $inbase = base($n, $b);
   }
   $additive_persistance, $n;
}

MAIN: {
   my @numbers = (5, 627615, 39390, 588225, 393900588225);
   my @bases = (2, 3, 8, 10, 16, 36);
   my $fmt = "%25s(%2s): persistance = %s, root = %2s\n";

   if( eval { require Math::BigInt; 1 } ) {
      push @numbers, Math::BigInt->new("5814271898167303040368".
      "1039458302204471300738980834668522257090844071443085937");
   }

   for my $base (@bases) {
      for my $num (@numbers) {
         my $inbase = base($num, $base);
         $inbase = 'BIG' if length($inbase) > 25;
         printf $fmt, $inbase, $base, digi_root($num, $base);
      }
      print "\n";
   }
}


//Dijkstra's algorithm: Nigel Galloway, August 5th., 2018
[<CustomEquality;CustomComparison>]
type Dijkstra<'N,'G when 'G:comparison>={toN:'N;cost:Option<'G>;fromN:'N}
                                        override g.Equals n =match n with| :? Dijkstra<'N,'G> as n->n.cost=g.cost|_->false
                                        override g.GetHashCode() = hash g.cost
                                        interface System.IComparable with
                                          member n.CompareTo g =
                                            match g with
                                            | :? Dijkstra<'N,'G> as n when n.cost=None -> (-1)
                                            | :? Dijkstra<'N,'G>      when n.cost=None -> 1
                                            | :? Dijkstra<'N,'G> as g                  -> compare n.cost g.cost
                                            | _-> invalidArg "n" "expecting type Dijkstra<'N,'G>"
let inline Dijkstra N G y =
  let rec fN l f=
    if List.isEmpty l then f
    else let n=List.min l
         if n.cost=None then f else
         fN(l|>List.choose(fun n'->if n'.toN=n.toN then None else match n.cost,n'.cost,Map.tryFind (n.toN,n'.toN) G with
                                                                  |Some g,None,Some wg                ->Some {toN=n'.toN;cost=Some(g+wg);fromN=n.toN}
                                                                  |Some g,Some g',Some wg when g+wg<g'->Some {toN=n'.toN;cost=Some(g+wg);fromN=n.toN}
                                                                  |_                                  ->Some n'))((n.fromN,n.toN)::f)
  let r = fN (N|>List.map(fun n->{toN=n;cost=(Map.tryFind(y,n)G);fromN=y})) []
  (fun n->let rec fN z l=match List.tryFind(fun (_,g)->g=z) r with
                         |Some(n',g') when y=n'->Some(n'::g'::l)
                         |Some(n',g')          ->fN n' (g'::l)
                         |_                    ->None
          fN n [])


with javascript_semantics

procedure digital_root(atom n, integer base=10)
    integer root, persistence = 1
    atom work = n
    while true do
        root = 0
        while work!=0 do
            root += remainder(work,base)
            work = floor(work/base)
        end while
        if root<base then exit end if
        work = root
        persistence += 1
    end while
    printf(1,"%15d root: %d persistence: %d\n",{n,root,persistence})
end procedure

digital_root(627615)
digital_root(39390)
digital_root(588225)
digital_root(393900588225)


go =>
  foreach(N in [627615,39390,588225,393900588225,
                58142718981673030403681039458302204471300738980834668522257090844071443085937])
    [Sum,Persistence] = digital_root(N),
    printf("%w har addititive persistence %d and digital root of %d\n", N,Persistence,Sum)
  end,
  nl.

%
% (Reduced) digit sum (digital root) of a number
%
digital_root(N) = [Sum,Persistence], integer(N)  =>
   Sum = N,
   Persistence = 0,
   while(Sum > 9)
     Sum := sum([I.to_integer() : I in Sum.to_string()]),
     Persistence := Persistence + 1
   end.