:- module floyd_warshall_task.

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

:- implementation.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module string.
:- import_module version_array2d.

%%%-------------------------------------------------------------------

%% Square arrays with 1-based indexing.

:- func arr_init(int, T) = version_array2d(T).
arr_init(N, Fill) = version_array2d.init(N, N, Fill).

:- func arr_get(version_array2d(T), int, int) = T.
arr_get(Arr, I, J) = Elem :-
  I1 = I - 1,
  J1 = J - 1,
  Elem = Arr^elem(I1, J1).

:- func arr_set(version_array2d(T), int, int, T) = version_array2d(T).
arr_set(Arr0, I, J, Elem) = Arr :-
  I1 = I - 1,
  J1 = J - 1,
  Arr = (Arr0^elem(I1, J1) := Elem).

%%%-------------------------------------------------------------------

:- func find_max_vertex(list({int, float, int})) = int.
find_max_vertex(Edges) = find_max_vertex_(Edges, 0).

:- func find_max_vertex_(list({int, float, int}), int) = int.
find_max_vertex_([], MaxVertex0) = MaxVertex0.
find_max_vertex_([{U, _, V} | Tail], MaxVertex0) = MaxVertex :-
  MaxVertex = find_max_vertex_(Tail, max(max(MaxVertex0, U), V)).

%%%-------------------------------------------------------------------

:- func arbitrary_float = float.
arbitrary_float = (12345.0).

:- func nil_vertex = int.
nil_vertex = 0.

:- func floyd_warshall(list({int, float, int})) =
   {int, version_array2d(float), version_array2d(int)}.
floyd_warshall(Edges) = {N, Dist, Next} :-
  N = find_max_vertex(Edges),
  Dist0 = arr_init(N, arbitrary_float),
  Next0 = arr_init(N, nil_vertex),
  (if (N = 0) then (Dist = Dist0,
                    Next = Next0)
   else ({Dist1, Next1} = floyd_warshall_initialize(Edges, N,
                                                    Dist0, Next0),
         {Dist, Next} = floyd_warshall_loop_k(N, 1, Dist1, Next1))).

:- func floyd_warshall_initialize(list({int, float, int}),
                                  int,
                                  version_array2d(float),
                                  version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_initialize(Edges, N, Dist0, Next0) = {Dist1, Next1} :-
  floyd_warshall_read_edges(Edges, Dist0, Next0) = {D1, X1},
  floyd_warshall_diagonals(N, 1, D1, X1) = {Dist1, Next1}.

:- func floyd_warshall_read_edges(list({int, float, int}),
                                  version_array2d(float),
                                  version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_read_edges([], Dist0, Next0) = {Dist0, Next0}.
floyd_warshall_read_edges([{U, Weight, V} | Tail],
                          Dist0, Next0) = {Dist1, Next1} :-
  D1 = arr_set(Dist0, U, V, Weight),
  X1 = arr_set(Next0, U, V, V),
  floyd_warshall_read_edges(Tail, D1, X1) = {Dist1, Next1}.

:- func floyd_warshall_diagonals(int, int,
                                 version_array2d(float),
                                 version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_diagonals(N, I, Dist0, Next0) = {Dist1, Next1} :-
  N1 = N + 1,
  (if (I = N1) then (Dist1 = Dist0,
                     Next1 = Next0)
   else (
     %% The distance from a vertex to itself = 0.0.
     D1 = arr_set(Dist0, I, I, 0.0),
     X1 = arr_set(Next0, I, I, I),
     I1 = I + 1,
     floyd_warshall_diagonals(N, I1, D1, X1) = {Dist1, Next1})).

:- func floyd_warshall_loop_k(int, int,
                              version_array2d(float),
                              version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_k(N, K, Dist0, Next0) = {Dist1, Next1} :-
  N1 = N + 1,
  (if (K = N1) then (Dist1 = Dist0,
                     Next1 = Next0)
   else ({D1, X1} = floyd_warshall_loop_i(N, K, 1, Dist0, Next0),
         K1 = K + 1,
         {Dist1, Next1} = floyd_warshall_loop_k(N, K1, D1, X1))).

:- func floyd_warshall_loop_i(int, int, int,
                              version_array2d(float),
                              version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_i(N, K, I, Dist0, Next0) = {Dist1, Next1} :-
  N1 = N + 1,
  (if (I = N1) then (Dist1 = Dist0,
                     Next1 = Next0)
   else ({D1, X1} = floyd_warshall_loop_j(N, K, I, 1, Dist0, Next0),
         I1 = I + 1,
         {Dist1, Next1} = floyd_warshall_loop_i(N, K, I1, D1, X1))).

:- func floyd_warshall_loop_j(int, int, int, int,
                              version_array2d(float),
                              version_array2d(int)) =
   {version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_j(N, K, I, J, Dist0, Next0) = {Dist1, Next1} :-
  J1 = J + 1,
  N1 = N + 1,
  (if (J = N1) then (Dist1 = Dist0,
                     Next1 = Next0)
   else (if ((arr_get(Next0, I, K) = nil_vertex);
             (arr_get(Next0, K, J) = nil_vertex))
        then ({Dist1, Next1} =
              floyd_warshall_loop_j(N, K, I, J1, Dist0, Next0))
        else (Dist_ikj = arr_get(Dist0, I, K) + arr_get(Dist0, K, J),
              (if (arr_get(Next0, I, J) = nil_vertex;
                   Dist_ikj < arr_get(Dist0, I, J))
               then (D1 = arr_set(Dist0, I, J, Dist_ikj),
                     X1 = arr_set(Next0, I, J, arr_get(Next0, I, K)),
                     {Dist1, Next1} =
                     floyd_warshall_loop_j(N, K, I, J1, D1, X1))
               else ({Dist1, Next1} =
                     floyd_warshall_loop_j(N, K, I, J1,
                                           Dist0, Next0)))))).

%%%-------------------------------------------------------------------

:- func path_string(version_array2d(int), int, int) = string.
path_string(Next, U, V) = S :-
  if (arr_get(Next, U, V) = nil_vertex) then S = ""
  else S = path_string_(Next, U, V, int_to_string(U)).

:- func path_string_(version_array2d(int), int, int, string) = string.
path_string_(Next, U, V, S0) = S :-
  (if (U = V) then (S = S0)
   else (U1 = arr_get(Next, U, V),
         S1 = append(append(S0, " -> "), int_to_string(U1)),
         path_string_(Next, U1, V, S1) = S)).

%%%-------------------------------------------------------------------

main(!IO) :-
  Example_graph = [{1, -2.0, 3},
                   {3, 2.0, 4},
                   {4, -1.0, 2},
                   {2, 4.0, 1},
                   {2, 3.0, 3}],
  {N, Dist, Next} = floyd_warshall(Example_graph),
  format("  pair    distance   path\n", [], !IO),
  format("-------------------------------------\n", [], !IO),
  main_loop_u(N, 1, Dist, Next, !IO).

:- pred main_loop_u(int, int,
                    version_array2d(float),
                    version_array2d(int),
                    io, io).
:- mode main_loop_u(in, in, in, in, di, uo) is det.
main_loop_u(N, U, Dist, Next, !IO) :-
  N1 = N + 1,
  (if (U = N1) then true
   else (main_loop_v(N, U, 1, Dist, Next, !IO),
         U1 = U + 1,
         main_loop_u(N, U1, Dist, Next, !IO))).

:- pred main_loop_v(int, int, int,
                    version_array2d(float),
                    version_array2d(int),
                    io, io).
:- mode main_loop_v(in, in, in, in, in, di, uo) is det.
main_loop_v(N, U, V, Dist, Next, !IO) :-
  V1 = V + 1,
  N1 = N + 1,
  (if (V = N1) then true
   else if (U = V) then main_loop_v(N, U, V1, Dist, Next, !IO)
   else (format(" %d -> %d    %4.1f     %s\n",
                [i(U), i(V), f(arr_get(Dist, U, V)),
                 s(path_string(Next, U, V))],
                !IO),
         main_loop_v(N, U, V1, Dist, Next, !IO))).

%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:


MODULE FloydWarshall;
FROM FormatString IMPORT FormatString;
FROM SpecialReals IMPORT Infinity;
FROM Terminal IMPORT ReadChar,WriteString,WriteLn;

CONST NUM_VERTICIES = 4;
TYPE
    IntArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF INTEGER;
    RealArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF REAL;

PROCEDURE FloydWarshall(weights : ARRAY OF ARRAY OF INTEGER);
VAR
    dist : RealArray;
    next : IntArray;
    i,j,k : INTEGER;
BEGIN
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            dist[i,j] := Infinity;
        END
    END;
    k := HIGH(weights);
    FOR i:=0 TO k DO
        dist[weights[i,0]-1,weights[i,1]-1] := FLOAT(weights[i,2]);
    END;
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            IF i#j THEN
                next[i,j] := j+1;
            END
        END
    END;
    FOR k:=0 TO NUM_VERTICIES-1 DO
        FOR i:=0 TO NUM_VERTICIES-1 DO
            FOR j:=0 TO NUM_VERTICIES-1 DO
                IF dist[i,j] > dist[i,k] + dist[k,j] THEN
                    dist[i,j] := dist[i,k] + dist[k,j];
                    next[i,j] := next[i,k];
                END
            END
        END
    END;
    PrintResult(dist, next);
END FloydWarshall;

PROCEDURE PrintResult(dist : RealArray; next : IntArray);
VAR
    i,j,u,v : INTEGER;
    buf : ARRAY[0..63] OF CHAR;
BEGIN
    WriteString("pair     dist    path");
    WriteLn;
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            IF i#j THEN
                u := i + 1;
                v := j + 1;
                FormatString("%i -> %i    %2i     %i", buf, u, v, TRUNC(dist[i,j]), u);
                WriteString(buf);
                REPEAT
                    u := next[u-1,v-1];
                    FormatString(" -> %i", buf, u);
                    WriteString(buf);
                UNTIL u=v;
                WriteLn
            END
        END
    END
END PrintResult;

TYPE WeightArray = ARRAY[0..4],[0..2] OF INTEGER;
VAR weights : WeightArray;
BEGIN
    weights := WeightArray{
        {1,  3, -2},
        {2,  1,  4},
        {2,  3,  3},
        {3,  4,  2},
        {4,  2, -1}
    };

    FloydWarshall(weights);

    ReadChar
END FloydWarshall.


import sequtils, strformat

type
  Weight = tuple[src, dest, value: int]
  Weights = seq[Weight]

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

proc printResult(dist: seq[seq[float]]; next: seq[seq[int]]) =

  echo "pair     dist    path"
  for i in 0..next.high:
    for j in 0..next.high:
      if i != j:
        var u = i + 1
        let v = j + 1
        var path = fmt"{u} -> {v}    {dist[i][j].toInt:2d}     {u}"
        while true:
          u = next[u-1][v-1]
          path &= fmt" -> {u}"
          if u == v: break
        echo path

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

proc floydWarshall(weights: Weights; numVertices: Positive) =

  var dist = repeat(repeat(Inf, numVertices), numVertices)
  for w in weights:
    dist[w.src - 1][w.dest - 1] = w.value.toFloat

  var next = repeat(newSeq[int](numVertices), numVertices)
  for i in 0..<numVertices:
    for j in 0..<numVertices:
      if i != j:
        next[i][j] = j + 1

  for k in 0..<numVertices:
    for i in 0..<numVertices:
      for j in 0..<numVertices:
        if dist[i][j] > dist[i][k] + dist[k][j]:
          dist[i][j] = dist[i][k] + dist[k][j]
          next[i][j] = next[i][k]

  printResult(dist, next)

#———————————————————————————————————————————————————————————————————————————————————————————————————

let weights: Weights = @[(1, 3, -2), (2, 1, 4), (2, 3, 3), (3, 4, 2), (4, 2, -1)]
let numVertices = 4

floydWarshall(weights, numVertices)


#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

import io
import ipl.array
import ipl.printf

record fw_results (n, distance, next_vertex)

procedure main ()
  local example_graph
  local fw
  local u, v

  example_graph := [[1, -2.0, 3],
                    [3, +2.0, 4],
                    [4, -1.0, 2],
                    [2, +4.0, 1],
                    [2, +3.0, 3]]

  fw := floyd_warshall (example_graph)

  printf ("  pair    distance   path\n")
  printf ("-------------------------------------\n")
  every u := 1 to fw.n do {
    every v := 1 to fw.n do {
      if u ~= v then {
        printf (" %d -> %d    %4s     %s\n", u, v,
                string (ref_array (fw.distance, u, v)),
                path_to_string (find_path (fw.next_vertex, u, v)))
      }
    }
  }
end

procedure floyd_warshall (edges)
  local n, distance, next_vertex
  local e
  local i, j, k
  local dist_ij, dist_ik, dist_kj, dist_ikj

  n := max_vertex (edges)
  distance := create_array ([1, 1], [n, n], &null)
  next_vertex := create_array ([1, 1], [n, n], &null)

  # Initialization.
  every e := !edges do {
    ref_array (distance, e[1], e[3]) := e[2]
    ref_array (next_vertex, e[1], e[3]) := e[3]
  }
  every i := 1 to n do {
    ref_array (distance, i, i) := 0.0 # Distance to self = 0.
    ref_array (next_vertex, i, i) := i
  }

  # Perform the algorithm. Here &null will play the role of
  # "infinity": "\" means a value is finite, "/" that it is infinite.
  every k := 1 to n do {
    every i := 1 to n do {
      every j := 1 to n do {
        dist_ij := ref_array (distance, i, j)
        dist_ik := ref_array (distance, i, k)
        dist_kj := ref_array (distance, k, j)
        if \dist_ik & \dist_kj then {
          dist_ikj := dist_ik + dist_kj
          if /dist_ij | dist_ikj < dist_ij then {
            ref_array (distance, i, j) := dist_ikj
            ref_array (next_vertex, i, j) :=
                ref_array (next_vertex, i, k)
          }
        }
      }
    }
  }

  return fw_results (n, distance, next_vertex)
end

procedure find_path (next_vertex, u, v)
  local path

  if / (ref_array (next_vertex, u, v)) then {
    path := []
  } else {
    path := [u]
    while u ~= v do {
      u := ref_array (next_vertex, u, v)
      put (path, u)
    }
  }
  return path
end

procedure path_to_string (path)
  local s

  if *path = 0 then {
    s := ""
  } else {
    s := string (path[1])
    every s ||:= (" -> " || !path[2 : 0])
  }
  return s
end

procedure max_vertex (edges)
  local e
  local m

  *edges = 0 & stop ("no edges")
  m := 1
  every e := !edges do m := max (m, e[1], e[3])
  return m
end


(*
  Floyd-Warshall algorithm.

  See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
 *)

module Square_array =

  (* Square arrays with 1-based indexing. *)

  struct
    type 'a t =
      {
        n : int;
        r : 'a Array.t
      }

    let make n fill =
      let r = Array.make (n * n) fill in
      { n = n; r = r }

    let get arr (i, j) =
      Array.get arr.r ((i - 1) + (arr.n * (j - 1)))

    let set arr (i, j) x =
      Array.set arr.r ((i - 1) + (arr.n * (j - 1))) x
  end

module Vertex =

  (* A vertex is a positive integer, or 0 for the nil object. *)

  struct
    type t = int

    let nil = 0

    let print_vertex u =
      print_int u

    let rec print_directed_list lst =
      match lst with
      | [] -> ()
      | [u] -> print_vertex u
      | u :: tail ->
         begin
           print_vertex u;
           print_string " -> ";
           print_directed_list tail
         end
  end

module Edge =

  (* A graph edge. *)

  struct
    type t =
      {
        u : Vertex.t;
        weight : Float.t;
        v : Vertex.t
      }

    let make u weight v =
      { u = u; weight = weight; v = v }
  end

module Paths =

  (* The "next vertex" array and its operations. *)

  struct
    type t = Vertex.t Square_array.t

    let make n =
      Square_array.make n Vertex.nil

    let get = Square_array.get
    let set = Square_array.set

    let path paths u v =
      (* Path reconstruction. In the finest tradition of the standard
         List module, this implementation is *not* tail recursive. *)
      if Square_array.get paths (u, v) = Vertex.nil then
        []
      else
        let rec build_path paths u v =
          if u = v then
            [v]
          else
            let i = Square_array.get paths (u, v) in
            u :: build_path paths i v
        in
        build_path paths u v

    let print_path paths u v =
      Vertex.print_directed_list (path paths u v)
  end

module Distances =

  (* The "distance" array and its operations. *)

  struct
    type t = Float.t Square_array.t

    let make n =
      Square_array.make n Float.infinity

    let get = Square_array.get
    let set = Square_array.set
  end

let find_max_vertex edges =
  (* This implementation is *not* tail recursive. *)
  let rec find_max =
    function
    | [] -> Vertex.nil
    | edge :: tail -> max (max Edge.(edge.u) Edge.(edge.v))
                        (find_max tail)
  in
  find_max edges

let floyd_warshall edges =
  (* This implementation assumes IEEE floating point. The OCaml Float
     module explicitly specifies 64-bit IEEE floating point. *)
  let _ = assert (edges <> []) in
  let n = find_max_vertex edges in
  let dist = Distances.make n in
  let next = Paths.make n in
  let rec read_edges =
    function
    | [] -> ()
    | edge :: tail ->
       let u = Edge.(edge.u) in
       let v = Edge.(edge.v) in
       let weight = Edge.(edge.weight) in
       begin
         Distances.set dist (u, v) weight;
         Paths.set next (u, v) v;
         read_edges tail
       end
  in
  begin

    (* Initialization. *)

    read_edges edges;
    for i = 1 to n do
      (* Distance from a vertex to itself = 0.0 *)
      Distances.set dist (i, i) 0.0;
      Paths.set next (i, i) i
    done;

    (* Perform the algorithm. *)

    for k = 1 to n do
      for i = 1 to n do
        for j = 1 to n do
          let dist_ij = Distances.get dist (i, j) in
          let dist_ik = Distances.get dist (i, k) in
          let dist_kj = Distances.get dist (k, j) in
          let dist_ikj = dist_ik +. dist_kj in
          if dist_ikj < dist_ij then
            begin
              Distances.set dist (i, j) dist_ikj;
              Paths.set next (i, j) (Paths.get next (i, k))
            end
        done
      done
    done;

    (* Return the results, as a 3-tuple. *)

    (n, dist, next)

  end

let example_graph =
  [Edge.make 1 (-2.0) 3;
   Edge.make 3 (+2.0) 4;
   Edge.make 4 (-1.0) 2;
   Edge.make 2 (+4.0) 1;
   Edge.make 2 (+3.0) 3]
;;

let (n, dist, next) =
  floyd_warshall example_graph
;;

print_string "  pair     distance    path";
print_newline ();
print_string "---------------------------------------";
print_newline ();
for u = 1 to n do
  for v = 1 to n do
    if u <> v then
      begin
        print_string " ";
        Vertex.print_directed_list [u; v];
        print_string "     ";
        Printf.printf "%4.1f" (Distances.get dist (u, v));
        print_string "      ";
        Paths.print_path next u v;
        print_newline ()
      end
  done
done
;;


sub FloydWarshall{
    my $edges = shift;
    my (@dist, @seq);
    my $num_vert = 0;
    # insert given dists into dist matrix
    map {
        $dist[$_->[0] - 1][$_->[1] - 1] = $_->[2];
        $num_vert = $_->[0] if $num_vert < $_->[0];
        $num_vert = $_->[1] if $num_vert < $_->[1];
    } @$edges;
    my @vertices = 0..($num_vert - 1);
    # init sequence/"next" table
    for my $i(@vertices){
        for my $j(@vertices){
            $seq[$i][$j] = $j if $i != $j;
        }
    }
    # diagonal of dists matrix
    #map {$dist[$_][$_] = 0} @vertices;
    for my $k(@vertices){
        for my $i(@vertices){
            next unless defined $dist[$i][$k];
            for my $j(@vertices){
                next unless defined $dist[$k][$j];
                if($i != $j && (!defined($dist[$i][$j])
                        || $dist[$i][$j] > $dist[$i][$k] + $dist[$k][$j])){
                    $dist[$i][$j] = $dist[$i][$k] + $dist[$k][$j];
                    $seq[$i][$j] = $seq[$i][$k];
                }
            }
        }
    }
    # print table
    print "pair     dist    path\n";
    for my $i(@vertices){
        for my $j(@vertices){
            next if $i == $j;
            my @path = ($i + 1);
            while($seq[$path[-1] - 1][$j] != $j){
                push @path, $seq[$path[-1] - 1][$j] + 1;
            }
            push @path, $j + 1;
            printf "%d -> %d  %4d     %s\n",
                $path[0], $path[-1], $dist[$i][$j], join(' -> ', @path);
        }
    }
}

my $graph = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]];
FloydWarshall($graph);


constant inf = 1e300*1e300

function Path(integer u, integer v, sequence next)
    if next[u,v]=null then
       return ""
    end if
    sequence path = {sprintf("%d",u)}
    while u!=v do
       u = next[u,v]
       path = append(path,sprintf("%d",u))
    end while
    return join(path,"->")
end function

procedure FloydWarshall(integer V, sequence weights)
    sequence dist = repeat(repeat(inf,V),V)
    sequence next = repeat(repeat(null,V),V)
    for k=1 to length(weights) do
      integer {u,v,w} = weights[k]
      dist[u,v] := w  -- the weight of the edge (u,v)
      next[u,v] := v
    end for
    -- standard Floyd-Warshall implementation
    for k=1 to V do
      for i=1 to V do
        for j=1 to V do
          atom d = dist[i,k] + dist[k,j]
          if dist[i,j] > d then
            dist[i,j] := d
            next[i,j] := next[i,k]
          end if
        end for
      end for
    end for
    printf(1,"pair  dist  path\n")
    for u=1 to V do
      for v=1 to V do
        if u!=v then
          printf(1,"%d->%d   %2d   %s\n",{u,v,dist[u,v],Path(u,v,next)})
        end if
      end for
    end for
end procedure

constant V = 4
constant weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
FloydWarshall(V,weights)


F floyd(rowcount)
   V rows = [[1]]
   L rows.len < rowcount
      V n = rows.last.last + 1
      rows.append(Array(n .. n + rows.last.len))
   R rows

F pfloyd(rows)
   V colspace = rows.last.map(n -> String(n).len)
   L(row) rows
      print(zip(colspace, row).map2((space, n) -> String(n).rjust(space)).join(‘ ’))

pfloyd(floyd(5))
pfloyd(floyd(14))


*        Floyd's triangle          21/06/2018
FLOYDTRI PROLOG
         L      R5,NN              nn
         BCTR   R5,0               -1
         M      R4,NN              nn*(nn-1)
         SRA    R5,1               /2
         A      R5,NN              m=(nn*(nn-1))/2+nn; max_value
         CVD    R5,XDEC            binary to packed decimal (PL8)
         EDMK   ZN,XDEC+4          packed dec (PL4) to char (CL8)
         S      R1,=A(ZN)          r1=number of spaces
         L      R9,=A(L'ZN+1)      length(zn08)+1
         SR     R9,R1              s=length(m)+1
         SR     R8,R8              k=0
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,NN)       do i=1 to nn
         LA     R10,PG               pgi=0
         LA     R7,1                 j=1
       DO WHILE=(CR,R7,LE,R6)          do j=1 to i
         LA     R8,1(R8)               k=k+1
         XDECO  R8,XDEC                k
         LA     R11,XDEC+12            +12
         SR     R11,R9                 -s
         LR     R2,R9                  s
         BCTR   R2,0                   -1
         EX     R2,MVCX                mvc @PG+pgi,@XDEC+12-s,LEN=s
         AR     R10,R9                 pgi+=s
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         EPILOG
MVCX     MVC    0(0,R10),0(R11)    mvc PG,XDEC
NN       DC     F'14'              number of rows
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp
ZN       DC     X'4020202020202020'  mask CL8 7num
         YREGS
         END    FLOYDTRI


PROC Triangle(BYTE level)
  INT v,i
  BYTE x,y
  BYTE ARRAY widths(20)
  CHAR ARRAY tmp(5)

  v=1
  FOR y=1 TO level-1
  DO
    v==+y
  OD
  FOR x=0 TO level-1
  DO
    StrI(v+x,tmp)
    widths(x)=tmp(0)
  OD

  v=1
  FOR y=1 TO level
  DO
    FOR x=0 TO y-1
    DO
      StrI(v,tmp)
      FOR i=tmp(0) TO widths(x)-1
      DO
        Put(32)
      OD
      Print(tmp)
      IF x<y-1 THEN
        Put(32)
      ELSE
        PutE()
      FI
      v==+1
    OD
  OD
RETURN

PROC Main()
  BYTE LMARGIN=$52,oldLMARGIN

  oldLMARGIN=LMARGIN
  LMARGIN=0 ;remove left margin on the screen

  Put(125) PutE() ;clear the screen
  Triangle(5)
  PutE()
  Triangle(13)

  LMARGIN=oldLMARGIN ;restore left margin on the screen
RETURN


with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Command_Line;

procedure Floyd_Triangle is
  rows : constant Natural := Natural'Value(Ada.Command_Line.Argument(1));
begin
  for r in 1..rows loop
    for i in 1..r loop
      Ada.Integer_Text_IO.put (r*(r-1)/2+i, Width=> Natural'Image(rows*(rows-1)/2+i)'Length);
    end loop;
    Ada.Text_IO.New_Line;
  end loop;
end Floyd_Triangle;


:- use_module(library(clpfd)).

path(List, To, From, [From], W) :-
    select([To,From,W],List,_).
path(List, To, From, [Link|R], W) :-
    select([To,Link,W1],List,Rest),
    W #= W1 + W2,
    path(Rest, Link, From, R, W2).

find_path(Din, From, To, [From|Pout], Wout) :-
    between(1, 4, From),
    between(1, 4, To),
    dif(From, To),
    findall([W,P], (
                path(Din, From, To, P, W),
                all_distinct(P)
            ), Paths),
    sort(Paths, [[Wout,Pout]|_]).

print_all_paths :-
    D = [[1, 3, -2], [2, 3, 3], [2, 1, 4], [3, 4, 2], [4, 2, -1]],
    format('Pair\t  Dist\tPath~n'),
    forall(
        find_path(D, From, To, Path, Weight),(
            atomic_list_concat(Path, ' -> ', PPath),
            format('~p -> ~p\t  ~p\t~w~n', [From, To, Weight, PPath]))).


# procedure to print a Floyd's Triangle with n lines                      #
PROC floyds triangle = ( INT n )VOID:
BEGIN

    # calculate the number of the highest number that will be printed     #
    # ( the sum of the integers 1, 2, ... n )                             #
    INT max number = ( n * ( n + 1 ) ) OVER 2;

    # determine the widths required to print the numbers of the final row #
    [ n ]INT widths;
    INT number := max number + 1;
    FOR col FROM n BY -1 TO 1 DO
        widths[ col ] := - ( UPB whole( number -:= 1, 0 ) + 1 )
    OD;

    # print the triangle                                                  #
    INT element := 0;
    FOR row TO n DO
        FOR col TO row DO
            print( ( whole( element +:= 1, widths[ col ] ) ) )
        OD;
        print( ( newline ) )
    OD

END; # floyds triangle #

main: (

    floyds triangle(  5 );
    print( ( newline ) );
    floyds triangle( 14 )

)


begin
    % prints a Floyd's Triangle with n lines                                  %
    procedure floydsTriangle ( integer value n ) ;
    begin
        % the triangle should be left aligned with the individual numbers     %
        % right-aligned with only one space before the number in the final    %
        % row                                                                 %
        % calculate the highest number that will be printed                   %
        % ( the sum of the integeregers 1, 2, ... n )                         %
        integer array widths( 1 :: n );
        integer maxNumber, number;
        maxNumber := ( n * ( n + 1 ) ) div 2;
        % determine the widths required to print the numbers of the final row %
        number := maxNumber;
        for col := n step -1 until 1 do begin
            integer v, w;
            w      := 0;
            v      := number;
            number := number - 1;
            while v > 0 do begin
                w  := w + 1;
                v  := v div 10
            end while_v_gt_0 ;
            widths( col ) := w
        end for_col;
        % print the triangle                                                  %
        number := 0;
        for row := 1 until n do begin
            for col := 1 until row do begin
                number := number + 1;
                writeon( i_w := widths( col ), s_w := 0, " ", number )
            end for_col ;
            write()
        end for_row
    end; % floyds triangle %

    floydsTriangle(  5 );
    write();
    floydsTriangle( 14 )

end.


from math import inf
from itertools import product

def floyd_warshall(n, edge):
    rn = range(n)
    dist = [[inf] * n for i in rn]
    nxt  = [[0]   * n for i in rn]
    for i in rn:
        dist[i][i] = 0
    for u, v, w in edge:
        dist[u-1][v-1] = w
        nxt[u-1][v-1] = v-1
    for k, i, j in product(rn, repeat=3):
        sum_ik_kj = dist[i][k] + dist[k][j]
        if dist[i][j] > sum_ik_kj:
            dist[i][j] = sum_ik_kj
            nxt[i][j]  = nxt[i][k]
    print("pair     dist    path")
    for i, j in product(rn, repeat=2):
        if i != j:
            path = [i]
            while path[-1] != j:
                path.append(nxt[path[-1]][j])
            print("%d → %d  %4d       %s"
                  % (i + 1, j + 1, dist[i][j],
                     ' → '.join(str(p + 1) for p in path)))

if __name__ == '__main__':
    floyd_warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]])


-- FLOYDs TRIANGLE -----------------------------------------------------------

-- floyd :: Int -> [[Int]]
on floyd(n)
    script floydRow
        on |λ|(start, row)
            {start + row + 1, enumFromTo(start, start + row)}
        end |λ|
    end script

    snd(mapAccumL(floydRow, 1, enumFromTo(0, n - 1)))
end floyd

-- showFloyd :: [[Int]] -> String
on showFloyd(xss)
    set ws to map(compose({my succ, my |length|, my show}), |last|(xss))

    script aligned
        on |λ|(xs)
            script pad
                on |λ|(w, x)
                    justifyRight(w, space, show(x))
                end |λ|
            end script

            concat(zipWith(pad, ws, xs))
        end |λ|
    end script

    unlines(map(aligned, xss))
end showFloyd

-- TEST ----------------------------------------------------------------------
on run
    script test
        on |λ|(n)
            showFloyd(floyd(n)) & linefeed
        end |λ|
    end script

    unlines(map(test, {5, 14}))
end run

-- GENERIC FUNCTIONS ---------------------------------------------------------

-- compose :: [(a -> a)] -> (a -> a)
on compose(fs)
    script
        on |λ|(x)
            script
                on |λ|(f, a)
                    mReturn(f)'s |λ|(a)
                end |λ|
            end script

            foldr(result, x, fs)
        end |λ|
    end script
end compose

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if n < m then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- foldr :: (b -> a -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(item i of xs, v, i, xs)
        end repeat
        return v
    end tell
end foldr

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- justifyRight :: Int -> Char -> Text -> Text
on justifyRight(n, cFiller, strText)
    if n > length of strText then
        text -n thru -1 of ((replicate(n, cFiller) as text) & strText)
    else
        strText
    end if
end justifyRight

-- last :: [a] -> a
on |last|(xs)
    if length of xs > 0 then
        item -1 of xs
    else
        missing value
    end if
end |last|

-- length :: [a] -> Int
on |length|(xs)
    length of xs
end |length|

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- 'The mapAccumL function behaves like a combination of map and foldl;
-- it applies a function to each element of a list, passing an
-- accumulating parameter from left to right, and returning a final
-- value of this accumulator together with the new list.' (see Hoogle)

-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
on mapAccumL(f, acc, xs)
    script
        on |λ|(a, x)
            tell mReturn(f) to set pair to |λ|(item 1 of a, x)
            [item 1 of pair, (item 2 of a) & {item 2 of pair}]
        end |λ|
    end script

    foldl(result, [acc, []], xs)
end mapAccumL

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length

-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if n < 1 then return out
    set dbl to {a}

    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- snd :: (a, b) -> b
on snd(xs)
    if class of xs is list and length of xs > 1 then
        item 2 of xs
    else
        missing value
    end if
end snd

-- show :: a -> String
on show(e)
    set c to class of e
    if c = list then
        script serialized
            on |λ|(v)
                show(v)
            end |λ|
        end script

        "{" & intercalate(", ", map(serialized, e)) & "}"
    else if c = record then
        script showField
            on |λ|(kv)
                set {k, v} to kv
                k & ":" & show(v)
            end |λ|
        end script

        "{" & intercalate(", ", ¬
            map(showField, zip(allKeys(e), allValues(e)))) & "}"
    else if c = date then
        ("date \"" & e as text) & "\""
    else if c = text then
        "\"" & e & "\""
    else
        try
            e as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end show

-- succ :: Int -> Int
on succ(x)
    x + 1
end succ

-- unlines :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith


#lang typed/racket
(require math/array)

;; in : initialized dist and next matrices
;; out : dist and next matrices
;; O(n^3)
(define-type Next-T (Option Index))
(define-type Dist-T Real)
(define-type Dists (Array Dist-T))
(define-type Nexts (Array Next-T))
(define-type Settable-Dists (Settable-Array Dist-T))
(define-type Settable-Nexts (Settable-Array Next-T))

(: floyd-with-path (-> Index Dists Nexts (Values Dists Nexts)))
(: init-edges (-> Index (Values Settable-Dists Settable-Nexts)))

(define (floyd-with-path n dist-in next-in)
  (define dist : Settable-Dists (array->mutable-array dist-in))
  (define next : Settable-Nexts (array->mutable-array next-in))
  (for* ((k n) (i n) (j n))
    (when (negative? (array-ref dist (vector j j)))
      (raise 'negative-cycle))
    (define i.k (vector i k))
    (define i.j (vector i j))
    (define d (+ (array-ref dist i.k) (array-ref dist (vector k j))))
    (when (< d (array-ref dist i.j))
      (array-set! dist i.j d)
      (array-set! next i.j (array-ref next i.k))))
  (values dist next))

;; utilities

;; init random edges costs, matrix 66% filled
(define (init-edges n)
  (define dist : Settable-Dists (array->mutable-array (make-array (vector n n) 0)))
  (define next : Settable-Nexts (array->mutable-array (make-array (vector n n) #f)))
  (for* ((i n) (j n) #:unless (= i j))
    (define i.j (vector i j))
    (array-set! dist i.j +Inf.0)
    (unless (< (random) 0.3)
      (array-set! dist i.j (add1 (random 100)))
      (array-set! next i.j j)))
  (values dist next))

;; show path from u to v
(: path (-> Nexts Index Index (Listof Index)))
(define (path next u v)
  (let loop : (Listof Index) ((u : Index u) (rv : (Listof Index) null))
    (if (= u v)
        (reverse (cons u rv))
        (let ((nxt (array-ref next (vector u v))))
          (if nxt (loop nxt (cons u rv)) null)))))

;; show computed distance
(: mdist (-> Dists Index Index Dist-T))
(define (mdist dist u v)
  (array-ref dist (vector u v)))

(module+ main
  (define n 8)
  (define-values (dist next) (init-edges n))
  (define-values (dist+ next+) (floyd-with-path n dist next))
  (displayln "original dist")
  dist
  (displayln "new dist and next")
  dist+
  next+
  ;; note, these path and dist calls are not as carefully crafted as
  ;; the echolisp ones (in fact they're verbatim copied)
  (displayln "paths and distances")
  (path  next+ 1 3)
  (mdist dist+ 1 0)
  (mdist dist+ 0 3)
  (mdist dist+ 1 3)
  (path next+ 7 6)
  (path next+ 6 7))


floyd: function [rowcount][
    result: new [[1]]
    while [rowcount > size result][
        n: inc last last result
        row: new []
        loop n..n+size last result 'k -> 'row ++ @[k]
        'result ++ @[row]
    ]
    return result
]

loop [5 14] 'j [
    f: floyd j
    loop f 'row -> print map row 'r [pad to :string r 3]
    print ""
]


Floyds_triangle(row){
	i = 0
	loop %row%
	{
		n := A_Index
		loop, %n%
		{
			m := n, j := i, i++
			while (m<row)
				j += m , m++
			res .= spaces(StrLen(j+1)-StrLen(i) +(A_Index=1?0:1)) i
		}
		if (A_Index < row)
			res .= "`r`n"
	}
	return res
}
Spaces(no){
	loop, % no
		res.=" "
	return % res
}


#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

#
# A C programmer might take note that the most rapid stride in an
# array is on the *leftmost* index, rather than the *rightmost* as in
# C.
#
# (In other words, Fortran has "column-major order", whereas C has
# "row-major order". I prefer to think of it in terms of strides. For
# one thing, in my opinion, which index is for a "column" and which
# for a "row" should be considered arbitrary unless dictated by
# context.)
#

# VLIMIT = the maximum number of vertices the program can handle.
define(VLIMIT, 100)

# NILVTX = the nil vertex.
define(NILVTX, 0)

# STRSZ = a buffer size used in some character-handling routines.
define(STRSZ, 300)

# BUFSZ = a buffer size used in some character-handling routines.
define(BUFSZ, 20)

function maxvtx (numedg, edges)

  # Find the maximum vertex number.

  implicit none

  integer numedg
  real edges(1:3, 1:numedg)     # Notice Fortran's column-major order!
  integer maxvtx

  integer n, i

  n = 1
  for (i = 1; i <= numedg; i = i + 1)
    {
      n = max (n, int (edges(1, i)))
      n = max (n, int (edges(3, i)))
    }
  maxvtx = n
end

subroutine floyd (numedg, edges, n, dist, nxtvtx)

  # Floyd-Warshall.

  implicit none

  integer numedg
  real edges(1:3, 1:numedg)     # Notice Fortran's column-major order!
  integer n
  real dist(1:VLIMIT, 1:VLIMIT)
  integer nxtvtx(1:VLIMIT, 1:VLIMIT)

  #
  # This implementation does NOT initialize elements of "dist" that
  # would be set "infinite" in the original Fortran 90. Such elements
  # are left uninitialized. Instead you should use the "nxtvtx" array
  # to determine whether there exists a finite path from one vertex to
  # another.
  #
  # See also the Icon and Object Icon implementations that use "&null"
  # as a stand-in for "infinity". This implementation is similar to
  # those. In this Ratfor, the nil entry in "nxtvtx" is used instead
  # of one in "dist".
  #

  integer i, j, k
  integer u, v
  real dstikj

  # Initialization.

  for (i = 1; i <= n; i = i + 1)
    for (j = 1; j <= n; j = j + 1)
      nxtvtx(i, j) = NILVTX
  for (i = 1; i <= numedg; i = i + 1)
    {
      u = int (edges(1, i))
      v = int (edges(3, i))
      dist(u, v) = edges(2, i)
      nxtvtx(u, v) = v
    }
  for (i = 1; i <= n; i = i + 1)
    {
      dist(i, i) = 0.0          # Distance from a vertex to itself.
      nxtvtx(i, i) = i
    }

  # Perform the algorithm.

  for (k = 1; k <= n; k = k + 1)
    for (i = 1; i <= n; i = i + 1)
      for (j = 1; j <= n; j = j + 1)
        if (nxtvtx(i, k) != NILVTX && nxtvtx(k, j) != NILVTX)
          {
            dstikj = dist(i, k) + dist(k, j)
            if (nxtvtx(i, j) == NILVTX)
              {
                dist(i, j) = dstikj
                nxtvtx(i, j) = nxtvtx(i, k)
              }
            else if (dstikj < dist(i, j))
              {
                dist(i, j) = dstikj
                nxtvtx(i, j) = nxtvtx(i, k)
              }
          }
end

subroutine cpy (chr, str, j)

  # A helper subroutine for pthstr.

  implicit none

  character*BUFSZ chr
  character str*STRSZ
  integer j

  integer i

  i = 1
  while (chr(i:i) == ' ')
    {
      if (i == BUFSZ)
        {
          write (*, *) "character* boundary exceeded in cpy"
          stop
        }
      i = i + 1
    }
  while (i <= BUFSZ)
    {
      if (STRSZ < j)
        {
          write (*, *) "character* boundary exceeded in cpy"
          stop
        }
      str(j:j) = chr(i:i)
      j = j + 1
      i = i + 1
    }
end

subroutine pthstr (nxtvtx, u, v, str, k)

  # Construct a string for a path from u to v. Start at str(k).

  implicit none

  integer nxtvtx(1:VLIMIT, 1:VLIMIT)
  integer u, v
  character str*STRSZ
  integer k

  integer i, j
  character*BUFSZ chr
  character*25 fmt10
  character*25 fmt20

  write (fmt10, '(''(I'', I15, '')'')') BUFSZ - 1
  write (fmt20, '(''(A'', I15, '')'')') BUFSZ

  if (nxtvtx(u, v) != NILVTX)
    {
      j = k
      i = u
      chr = ' '
      write (chr, fmt10) i
      call cpy (chr, str, j)
      while (i != v)
        {
          write (chr, fmt20) "-> "
          call cpy (chr, str, j)
          i = nxtvtx(i, v)
          write (chr, fmt10) i
          call cpy (chr, str, j)
        }
    }
end

function trimr (str)

  # Find the length of a character*, if one ignores trailing spaces.

  implicit none

  character str*STRSZ
  integer trimr

  logical done

  trimr = STRSZ
  done = .false.
  while (!done)
    {
      if (trimr == 0)
        done = .true.
      else if (str(trimr:trimr) != ' ')
        done = .true.
      else
        trimr = trimr - 1
    }
end

program demo
  implicit none

  integer maxvtx
  integer trimr

  integer exmpsz
  real exampl(1:3, 1:5)
  integer n
  real dist(1:VLIMIT, 1:VLIMIT)
  integer nxtvtx(1:VLIMIT, 1:VLIMIT)
  character str*STRSZ
  integer u, v
  integer j

  exmpsz = 5
  data exampl / 1, -2.0, 3,   _
                3, +2.0, 4,   _
                4, -1.0, 2,   _
                2, +4.0, 1,   _
                2, +3.0, 3 /

  n = maxvtx (exmpsz, exampl)
  call floyd (exmpsz, exampl, n, dist, nxtvtx)

1000 format (I2, ' ->', I2, 5X, F4.1, 6X)

  write (*, '(''  pair     distance    path'')')
  write (*, '(''---------------------------------------'')')
  for (u = 1; u <= n; u = u + 1)
    for (v = 1; v <= n; v = v + 1)
      if (u != v)
        {
          str = ' '
          write (str, 1000) u, v, dist(u, v)
          call pthstr (nxtvtx, u, v, str, 23)
          write (* , '(1000A1)') (str(j:j), j = 1, trimr (str))
        }
end


/*REXX program uses Floyd─Warshall algorithm to find shortest distance between vertices.*/
v= 4             /*███       {1}       ███*/     /*number of vertices in weighted graph.*/
@.= 99999999     /*███    4 /   \ -2   ███*/     /*the default distance  (edge weight). */
@.1.3= -2        /*███     /  3  \     ███*/     /*the distance (weight) for an edge.   */
@.2.1=  4        /*███  {2} ────► {3}  ███*/     /* "     "         "     "   "   "     */
@.2.3=  3        /*███     \     /     ███*/     /* "     "         "     "   "   "     */
@.3.4=  2        /*███   -1 \   / 2    ███*/     /* "     "         "     "   "   "     */
@.4.2= -1        /*███       {4}       ███*/     /* "     "         "     "   "   "     */

            do     k=1  for v
              do   i=1  for v
                do j=1  for v;  _= @.i.k + @.k.j /*add two nodes together.              */
                if @.i.j>_  then @.i.j= _        /*use a new distance (weight) for edge.*/
                end   /*j*/
              end     /*i*/
            end       /*k*/
w= 12;                     $= left('', 20)       /*width of the columns for the output. */
say $ center('vertices',w) center('distance', w) /*display the  1st  line of the title. */
say $ center('pair'    ,w) center('(weight)', w) /*   "     "   2nd    "   "  "    "    */
say $ copies('═'       ,w) copies('═'       , w) /*   "     "   3rd    "   "  "    "    */
                                                 /* [↓]  display edge distances (weight)*/
   do   f=1  for v                               /*process each of the "from" vertices. */
     do t=1  for v;    if f==t  then iterate     /*   "      "   "  "   "to"      "     */
     say  $      center(f '───►' t, w)        right(@.f.t, w % 2)
     end   /*t*/                                 /* [↑]  the distance between 2 vertices*/
   end     /*f*/                                 /*stick a fork in it,  we're all done. */


#!/bin/awk -f

BEGIN {
	if (rows !~ /^[0-9]+$/ || rows < 0) {
		print "invalid rows or missing from command line"
		print "syntax: awk -v rows=14 -f floyds_triangle.awk"
		exit 1
	}

	for (row=cols=1; row<=rows; row++ cols++) {
		width[row] = length(row + (rows * (rows-1))/2)
		for (col=1; col<=cols; col++)
			printf("%*d%c", width[col], ++n, row == col ? "\n" : " ")
	}
}


 100 :
 110  REM  FLOYD'S TRIANGLE
 120 :
 130  DEF  FN Q(A) =  INT ( LOG (A) /  LOG (10)) + 1
 140 N = 14
 150  DIM P(N): P(0) =  - 1: FOR J = 1 TO N: I = (N * N - N) / 2 + J
 160 P(J) = P(J - 1) + FN Q(I) + 1: NEXT J
 200  FOR R = 1 TO N: FOR C = 1 TO R
 210 NR = NR + 1:COL = P(C) - ( FN Q(NR) - 1)
 220  HTAB COL: PRINT NR;: NEXT C
 230  PRINT : NEXT R


def floyd_warshall(n, edge)
  dist = Array.new(n){|i| Array.new(n){|j| i==j ? 0 : Float::INFINITY}}
  nxt = Array.new(n){Array.new(n)}
  edge.each do |u,v,w|
    dist[u-1][v-1] = w
    nxt[u-1][v-1] = v-1
  end

  n.times do |k|
    n.times do |i|
      n.times do |j|
        if dist[i][j] > dist[i][k] + dist[k][j]
          dist[i][j] = dist[i][k] + dist[k][j]
          nxt[i][j] = nxt[i][k]
        end
      end
    end
  end

  puts "pair     dist    path"
  n.times do |i|
    n.times do |j|
      next  if i==j
      u = i
      path = [u]
      path << (u = nxt[u][j])  while u != j
      path = path.map{|u| u+1}.join(" -> ")
      puts "%d -> %d  %4d     %s" % [i+1, j+1, dist[i][j], path]
    end
  end
end

n = 4
edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
floyd_warshall(n, edge)


with Ada.Text_IO; use Ada.Text_IO;

procedure Main is
   subtype Block is String (1 .. 80);
   Infile_Name  : String := "infile.dat";
   outfile_Name : String := "outfile.dat";
   Infile       : File_Type;
   outfile      : File_Type;

   Line : Block := (Others => ' ');
begin
   Open (File => Infile, Mode => In_File, Name => Infile_Name);
   Create (File => outfile, Mode => Out_File, Name => outfile_Name);

   Put_Line("Input data:");
   New_Line;
   while not End_Of_File (Infile) loop
      Get (File => Infile, Item => Line);
      Put(Line);
      New_Line;
      for I in reverse Line'Range loop
         Put (File => outfile, Item => Line (I));
      end loop;
   end loop;

   Close (Infile);
   Close (outfile);

   Open(File => infile,
        Mode => In_File,
        Name => outfile_name);
   New_Line;
   Put_Line("Output data:");
   New_Line;
   while not End_Of_File(Infile) loop
      Get(File => Infile,
          Item => Line);
      Put(Line);
      New_Line;
   end loop;
end Main;


:: Floyd's triangle Task from Rosetta Code
:: Batch File Implementation

@echo off
rem main thing
setlocal enabledelayedexpansion
call :floydtriangle 5
echo(
call :floydtriangle 14
exit /b 0

:floydtriangle
set "fila=%1"
for /l %%c in (1,1,%fila%) do (
    set /a "lastRowNum=%%c+fila*(fila-1)/2"
    rem count number of digits of whole number trick
    rem source: https://stackoverflow.com/a/45472269
    set /a "Log=1!lastRowNum:~1!-!lastRowNum:~1!-0"
    set /a "numColum[%%c]=!Log:0=+1!"
)
echo(Output for %fila%
set "thisNum=1"
for /l %%r in (1,1,%fila%) do (
    set "printLine="
    for /l %%c in (1,1,%%r) do (
        rem count number of digits of whole number trick
        set /a "Log=1!thisNum:~1!-!thisNum:~1!-0"
        set /a "thisNumColum=!Log:0=+1!"
        rem handle spacing
        set "space= "
        set /a "extra=!numColum[%%c]!-!thisNumColum!"
        for /l %%s in (1,1,!extra!) do set "space=!space! "
        rem append current number to printLine
        set "printLine=!printLine!!space!!thisNum!"
        set /a "thisNum=!thisNum!+1"
    )
    echo(!printLine!
)
goto :EOF


pub type Edge = (usize, usize);

#[derive(Clone, Debug, PartialEq, Eq, Hash)]
pub struct Graph<T> {
    size: usize,
    edges: Vec<Option<T>>,
}

impl<T> Graph<T> {
    pub fn new(size: usize) -> Self {
        Self {
            size,
            edges: std::iter::repeat_with(|| None).take(size * size).collect(),
        }
    }

    pub fn new_with(size: usize, f: impl FnMut(Edge) -> Option<T>) -> Self {
        let edges = (0..size)
            .flat_map(|i| (0..size).map(move |j| (i, j)))
            .map(f)
            .collect();

        Self { size, edges }
    }

    pub fn with_diagonal(mut self, mut f: impl FnMut(usize) -> Option<T>) -> Self {
        self.edges
            .iter_mut()
            .step_by(self.size + 1)
            .enumerate()
            .for_each(move |(vertex, edge)| *edge = f(vertex));

        self
    }

    pub fn size(&self) -> usize {
        self.size
    }

    pub fn edge(&self, edge: Edge) -> &Option<T> {
        let index = self.edge_index(edge);
        &self.edges[index]
    }

    pub fn edge_mut(&mut self, edge: Edge) -> &mut Option<T> {
        let index = self.edge_index(edge);
        &mut self.edges[index]
    }

    fn edge_index(&self, (row, col): Edge) -> usize {
        assert!(row < self.size && col < self.size);
        row * self.size() + col
    }
}

impl<T> std::ops::Index<Edge> for Graph<T> {
    type Output = Option<T>;

    fn index(&self, index: Edge) -> &Self::Output {
        self.edge(index)
    }
}

impl<T> std::ops::IndexMut<Edge> for Graph<T> {
    fn index_mut(&mut self, index: Edge) -> &mut Self::Output {
        self.edge_mut(index)
    }
}

#[derive(Clone, Debug, PartialEq, Eq)]
pub struct Paths(Graph<usize>);

impl Paths {
    pub fn new<T>(graph: &Graph<T>) -> Self {
        Self(Graph::new_with(graph.size(), |(i, j)| {
            graph[(i, j)].as_ref().map(|_| j)
        }))
    }

    pub fn vertices(&self, from: usize, to: usize) -> Path<'_> {
        assert!(from < self.0.size() && to < self.0.size());

        Path {
            graph: &self.0,
            from: Some(from),
            to,
        }
    }

    fn update(&mut self, from: usize, to: usize, via: usize) {
        self.0[(from, to)] = self.0[(from, via)];
    }
}

#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub struct Path<'a> {
    graph: &'a Graph<usize>,
    from: Option<usize>,
    to: usize,
}

impl<'a> Iterator for Path<'a> {
    type Item = usize;

    fn next(&mut self) -> Option<Self::Item> {
        self.from.map(|from| {
            let result = from;

            self.from = if result != self.to {
                self.graph[(result, self.to)]
            } else {
                None
            };

            result
        })
    }
}

pub fn floyd_warshall<W>(mut result: Graph<W>) -> (Graph<W>, Option<Paths>)
where
    W: Copy + std::ops::Add<W, Output = W> + std::cmp::Ord + Default,
{
    let mut without_negative_cycles = true;
    let mut paths = Paths::new(&result);
    let n = result.size();

    for k in 0..n {
        for i in 0..n {
            for j in 0..n {
                // Negative cycle detection with T::default as the negative boundary
                if i == j && result[(i, j)].filter(|&it| it < W::default()).is_some() {
                    without_negative_cycles = false;
                    continue;
                }

                if let (Some(ik_weight), Some(kj_weight)) = (result[(i, k)], result[(k, j)]) {
                    let ij_edge = result.edge_mut((i, j));
                    let ij_weight = ik_weight + kj_weight;

                    if ij_edge.is_none() {
                        *ij_edge = Some(ij_weight);
                        paths.update(i, j, k);
                    } else {
                        ij_edge
                            .as_mut()
                            .filter(|it| ij_weight < **it)
                            .map_or((), |it| {
                                *it = ij_weight;
                                paths.update(i, j, k);
                            });
                    }
                }
            }
        }
    }

    (result, Some(paths).filter(|_| without_negative_cycles)) // No paths for negative cycles
}

fn format_path<T: ToString>(path: impl Iterator<Item = T>) -> String {
    path.fold(String::new(), |mut acc, x| {
        if !acc.is_empty() {
            acc.push_str(" -> ");
        }

        acc.push_str(&x.to_string());
        acc
    })
}

fn print_results<W, V>(weights: &Graph<W>, paths: Option<&Paths>, vertex: impl Fn(usize) -> V)
where
    W: std::fmt::Display + Default + Eq,
    V: std::fmt::Display,
{
    let n = weights.size();

    for from in 0..n {
        for to in 0..n {
            if let Some(weight) = &weights[(from, to)] {
                // Skip trivial information (i.e., default weight on the diagonal)
                if from == to && *weight == W::default() {
                    continue;
                }

                println!(
                    "{} -> {}: {} \t{}",
                    vertex(from),
                    vertex(to),
                    weight,
                    format_path(paths.iter().flat_map(|p| p.vertices(from, to)).map(&vertex))
                );
            }
        }
    }
}

fn main() {
    let graph = {
        let mut g = Graph::new(4).with_diagonal(|_| Some(0));
        g[(0, 2)] = Some(-2);
        g[(1, 0)] = Some(4);
        g[(1, 2)] = Some(3);
        g[(2, 3)] = Some(2);
        g[(3, 1)] = Some(-1);
        g
    };

    let (weights, paths) = floyd_warshall(graph);
    // Fixup the vertex name (as we use zero-based indices)
    print_results(&weights, paths.as_ref(), |index| index + 1);
}


;;; Floyd-Warshall algorithm.
;;;
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
;;;

(import (scheme base))
(import (scheme cxr))
(import (scheme write))

;;;
;;; A square array will be represented by a cons-pair:
;;;
;;;    (vector-of-length n-squared . n)
;;;
;;; Arrays are indexed *starting at one*.
;;;

(define (make-arr n fill)
  (cons (make-vector (* n n) fill) n))

(define (arr-set! arr i j x)
  (let ((vec (car arr))
        (n (cdr arr)))
    (vector-set! vec (+ (- i 1) (* n (- j 1))) x)))

(define (arr-ref arr i j)
  (let ((vec (car arr))
        (n (cdr arr)))
    (vector-ref vec (+ (- i 1) (* n (- j 1))))))

;;;
;;; Floyd-Warshall.
;;;
;;; Input is a list of length-3 lists representing edges; each entry
;;; is:
;;;
;;;    (start-vertex edge-weight end-vertex)
;;;
;;; where vertex identifiers are (to help keep this example brief)
;;; integers from 1 .. n.
;;;

(define (floyd-warshall edges)

  (define n
    ;; Set n to the maximum vertex number. By design, n also equals
    ;; the number of vertices.
    (max (apply max (map car edges))
         (apply max (map caddr edges))))

  (define distance (make-arr n +inf.0))
  (define next-vertex (make-arr n #f))

  ;; Initialize "distance" and "next-vertex".
  (for-each (lambda (edge)
              (let ((u (car edge))
                    (weight (cadr edge))
                    (v (caddr edge)))
                (arr-set! distance u v weight)
                (arr-set! next-vertex u v v)))
            edges)
  (do ((v 1 (+ v 1)))
      ((< n v))
    (arr-set! distance v v 0)
    (arr-set! next-vertex v v v))

  ;; Perform the algorithm.
  (do ((k 1 (+ k 1)))
      ((< n k))
    (do ((i 1 (+ i 1)))
        ((< n i))
      (do ((j 1 (+ j 1)))
          ((< n j))
        (let ((dist-ij (arr-ref distance i j))
              (dist-ik (arr-ref distance i k))
              (dist-kj (arr-ref distance k j)))
          (let ((dist-ik+dist-kj (+ dist-ik dist-kj)))
            (when (< dist-ik+dist-kj dist-ij)
              (arr-set! distance i j dist-ik+dist-kj)
              (arr-set! next-vertex i j
                        (arr-ref next-vertex i k))))))))

  ;; Return the results.
  (values n distance next-vertex))

;;;
;;; Path reconstruction from the "next-vertex" array.
;;;
;;; The return value is a list of vertices.
;;;

(define (find-path next-vertex u v)
  (if (not (arr-ref next-vertex u v))
      (list)
      (let loop ((u u)
                 (path (list u)))
        (if (= u v)
            (reverse path)
            (let ((u^ (arr-ref next-vertex u v)))
              (loop u^ (cons u^ path)))))))

(define (display-path path)
  (let loop ((p path))
    (cond ((null? p))
          ((null? (cdr p)) (display (car p)))
          (else (display (car p))
                (display " -> ")
                (loop (cdr p))))))

(define example-graph
  '((1 -2 3)
    (3 2 4)
    (4 -1 2)
    (2 4 1)
    (2 3 3)))

(let-values (((n distance next-vertex)
              (floyd-warshall example-graph)))
  (display " pair   distance    path")
  (newline)
  (display "------------------------------------")
  (newline)
  (do ((u 1 (+ u 1)))
      ((< n u))
    (do ((v 1 (+ v 1)))
        ((< n v))
      (unless (= u v)
        (display u)
        (display " -> ")
        (display v)
        (let* ((s (number->string (arr-ref distance u v)))
               (slen (string-length s))
               (padding (- 7 slen)))
          (display (make-string padding #\space))
          (display s))
        (display "      ")
        (display-path (find-path next-vertex u v))
        (newline)))))


# syntax: GAWK -f FIXED_LENGTH_RECORDS.AWK
BEGIN {
    vlr_fn = "FIXED_LENGTH_RECORDS.TXT"
    flr_fn = "FIXED_LENGTH_RECORDS.TMP"
    print("bef:")
    while (getline rec <vlr_fn > 0) { # read variable length records
      printf("%-80.80s",rec) >flr_fn # write fixed length records without CR/LF
      printf("%s\n",rec)
    }
    close(vlr_fn)
    close(flr_fn)
    print("aft:")
    getline rec <flr_fn # read entire file
    while (length(rec) > 0) {
      printf("%s\n",revstr(substr(rec,1,80),80))
      rec = substr(rec,81)
    }
    exit(0)
}
function revstr(str,start) {
    if (start == 0) {
      return("")
    }
    return( substr(str,start,1) revstr(str,start-1) )
}


#include <algorithm>
#include <cstdlib>
#include <fstream>
#include <iostream>

void reverse(std::istream& in, std::ostream& out) {
    constexpr size_t record_length = 80;
    char record[record_length];
    while (in.read(record, record_length)) {
        std::reverse(std::begin(record), std::end(record));
        out.write(record, record_length);
    }
    out.flush();
}

int main(int argc, char** argv) {
    std::ifstream in("infile.dat", std::ios_base::binary);
    if (!in) {
        std::cerr << "Cannot open input file\n";
        return EXIT_FAILURE;
    }
    std::ofstream out("outfile.dat", std::ios_base::binary);
    if (!out) {
        std::cerr << "Cannot open output file\n";
        return EXIT_FAILURE;
    }
    try {
        in.exceptions(std::ios_base::badbit);
        out.exceptions(std::ios_base::badbit);
        reverse(in, out);
    } catch (const std::exception& ex) {
        std::cerr << "I/O error: " << ex.what() << '\n';
        return EXIT_FAILURE;
    }
    return EXIT_SUCCESS;
}


get "libhdr"

let width(n) = n<10 -> 1, 1 + width(n/10)

let floyd(rows) be
$(  let maxno = rows * (rows+1)/2
    let num = 1
    for r = 1 to rows
    $(  for c = 1 to r
        $(  writed(num, 1 + width(maxno-rows+c))
            num := num + 1
        $)
        wrch('*N')
    $)
$)

let start() be
$(  floyd(5)
    wrch('*N')
    floyd(14)
$)


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

ARC ::= (To: int, Weight: float);
arc(t,w) := (To: t, Weight: w);
VERTEX ::= (Label: int, Arcs: ARC(1));
vertex(l,arcs(1)) := (Label: l, Arcs: arcs);

getArcsFrom(vertex, graph(1)) :=
    let
        index := firstIndexOf(graph.Label, vertex);
    in
        [] when index = 0
    else
        graph[index].Arcs;

getWeightTo(vertex, arcs(1)) :=
    let
        index := firstIndexOf(arcs.To, vertex);
    in
        0 when index = 0
    else
        arcs[index].Weight;

throughK(k, dist(2)) :=
    let
        newDist[i, j] := min(dist[i][k] + dist[k][j], dist[i][j]);
    in
        dist when k > size(dist)
    else
        throughK(k + 1, newDist);

floydWarshall(graph(1)) :=
    let
        initialResult[i,j] := 1.79769e308 when i /= j else 0
                              foreach i within 1 ... size(graph),
                                      j within 1 ... size(graph);

        singleResult[i,j] := getWeightTo(j, getArcsFrom(i, graph))
                             foreach i within 1 ... size(graph),
                                     j within 1 ... size(graph);

        start[i,j] :=
                initialResult[i,j] when singleResult[i,j] = 0
            else
                singleResult[i,j];
    in
        throughK(1, start);

main() :=
    let
        graph := [vertex(1, [arc(3,-2)]),
                  vertex(2, [arc(1,4), arc(3,3)]),
                  vertex(3, [arc(4,2)]),
                  vertex(4, [arc(2,-1)])];
    in
        floydWarshall(graph);


func floyd_warshall(n, edge) {
    var dist = n.of {|i| n.of { |j| i == j ? 0 : Inf }}
    var nxt  = n.of { n.of(nil) }
    for u,v,w in edge {
        dist[u-1][v-1] = w
         nxt[u-1][v-1] = v-1
    }

    [^n] * 3 -> cartesian { |k, i, j|
        if (dist[i][j] > dist[i][k]+dist[k][j]) {
            dist[i][j] = dist[i][k]+dist[k][j]
            nxt[i][j] = nxt[i][k]
        }
    }

    var summary = "pair     dist    path\n"
    for i,j (^n ~X ^n) {
        i==j && next
        var u = i
        var path = [u]
        while (u != j) {
            path << (u = nxt[u][j])
        }
        path.map!{|u| u+1 }.join!(" -> ")
        summary += ("%d -> %d  %4d     %s\n" % (i+1, j+1, dist[i][j], path))
    }

    return summary
}

var n = 4
var edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
print floyd_warshall(n, edge)


      *> Rosetta Code, fixed length records
      *> Tectonics:
      *>   cobc -xj lrecl80.cob
       identification division.
       program-id. lrecl80.

       environment division.
       configuration section.
       repository.
           function all intrinsic.

       input-output section.
       file-control.
           select infile
               assign to infile-name
               organization is sequential
               file status is infile-status
           .
           select outfile
               assign to outfile-name
               organization is sequential
               file status is outfile-status
           .

       data division.
       file section.
       fd infile.
           01 input-text pic x(80).

       fd outfile.
           01 output-text pic x(80).

       working-storage section.
       01 infile-name.
          05 value "infile.dat".
       01 infile-status pic xx.
          88 ok-input value '00'.
          88 eof-input value '10'.

       01 outfile-name.
          05 value "outfile.dat".
       01 outfile-status pic xx.
          88 ok-output value '00'.

       procedure division.

       open input infile
       if not ok-input then
           display "error opening input " infile-name upon syserr
           goback
       end-if

       open output outfile
       if not ok-output
           display "error opening output " outfile-name upon syserr
           goback
       end-if

      *> read lrecl 80 and write the reverse as lrecl 80
       read infile
       perform until not ok-input
           move function reverse(input-text) to output-text

           write output-text
           if not ok-output then
               display "error writing: " output-text upon syserr
           end-if
           read infile
       end-perform

       close infile outfile

      *> from fixed length to normal text, outfile is now the input file
       open input outfile
       if not ok-output then
           display "error opening input " outfile-name upon syserr
           goback
       end-if

       read outfile
       perform until not ok-output
           display function trim(output-text trailing)
           read outfile
       end-perform

       close outfile

       goback.
       end program lrecl80.


Const As Byte longRegistro = 80
Const archivoEntrada As String = "infile.dat"
Const archivoSalida  As String = "outfile.dat"

Dim As String linea

'Abre el archivo origen para lectura
Open archivoEntrada For Input As #1
'Abre el archivo destino para escritura
Open archivoSalida For Output As #2

Print !"Datos de entrada:\n"
Do While Not Eof(1)
    Line Input #1, linea    'lee una linea
    Print linea             'imprime por pantalla esa linea
    For i As Integer = longRegistro To 1 Step -1
        Print #2, Chr(Asc(linea, i));    'escribe el inverso de la linea
    Next i
    Print #2, Chr(13);
Loop
Close #1, #2

Dim As Integer a
Open archivoSalida For Input As #2

Print !"\nDatos de salida:\n"
Do While Not Eof(2)
    Line Input #2, linea
    For j As Integer = 0 To Len(linea)-1
        Print Chr(linea[j]);
        a += 1: If a = longRegistro Then a = 0 : Print Chr(13)
    Next j
Loop
Close
Sleep


  ( ( floyd
    =   lowerLeftCorner lastInColumn lastInRow row i W w
      .   put$(str$("Floyd " !arg ":\n"))
        &   !arg*(!arg+-1)*1/2+1
          : ?lowerLeftCorner
          : ?lastInColumn
        & 1:?lastInRow:?row:?i
        &   whl
          ' ( !row:~>!arg
            & @(!lastInColumn:? [?W)
            & @(!i:? [?w)
            & whl'(!w+1:~>!W:?w&put$" ")
            & put$!i
            & (   !i:<!lastInRow
                & put$" "
                & 1+!lastInColumn:?lastInColumn
              |   put$\n
                & (1+!row:?row)+!lastInRow:?lastInRow
                & !lowerLeftCorner:?lastInColumn
              )
            & 1+!i:?i
            )
    )
  & floyd$5
  & floyd$14
  );


#include <stdio.h>

void t(int n)
{
	int i, j, c, len;

	i = n * (n - 1) / 2;
	for (len = c = 1; c < i; c *= 10, len++);
	c -= i; // c is the col where width changes

#define SPEED_MATTERS 0
#if SPEED_MATTERS	// in case we really, really wanted to print huge triangles often
	char tmp[32], s[4096], *p;

	sprintf(tmp, "%*d", len, 0);

	inline void inc_numstr(void) {
		int k = len;

	redo:	if (!k--) return;

		if (tmp[k] == '9') {
			tmp[k] = '0';
			goto redo;
		}

		if (++tmp[k] == '!')
			tmp[k] = '1';
	}

	for (p = s, i = 1; i <= n; i++) {
		for (j = 1; j <= i; j++) {
			inc_numstr();
			__builtin_memcpy(p, tmp + 1 - (j >= c), len - (j < c));
			p += len - (j < c);

			*(p++) = (i - j)? ' ' : '\n';

			if (p - s + len >= 4096) {
				fwrite(s, 1, p - s, stdout);
				p = s;
			}
		}
	}

	fwrite(s, 1, p - s, stdout);
#else // NO_IT_DOESN'T
	int num;
	for (num = i = 1; i <= n; i++)
		for (j = 1; j <= i; j++)
			printf("%*d%c",	len - (j < c), num++, i - j ? ' ':'\n');
#endif
}

int main(void)
{
	t(5), t(14);

	// maybe not
	// t(10000);
	return 0;
}


(*
  Floyd-Warshall algorithm.

  See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
 *)

(*------------------------------------------------------------------(*

   In this program, I introduce more "abstraction" than there was in
   earlier versions, which were written in the SML-like languages
   OCaml and ATS. This is an example of proceeding from where one has
   gotten so far, to turn a program into a better one. The
   improvements made here could be backported to the other languages.

   In most respects, though, this program is very similar to the
   OCaml.

   Standard ML seems to specify its REAL signature is for IEEE
   floating point, so this program assumes there is a positive
   "infinity". (The difference is tiny between an algorithm with
   "infinity" and one without.)

*)------------------------------------------------------------------*)

(* Square arrays with 1-based indexing. *)

signature SQUARE_ARRAY =
sig
  type 'a squareArray
  val make : int * 'a -> 'a squareArray
  val get : 'a squareArray -> int * int -> 'a
  val set : 'a squareArray -> int * int -> 'a -> unit
end

structure SquareArray : SQUARE_ARRAY =
struct

type 'a squareArray = int * 'a array

fun make (n, fill) =
    (n, Array.array (n * n, fill))

fun get (n, r) (i, j) =
    Array.sub (r, (i - 1) + (n * (j - 1)))

fun set (n, r) (i, j) x =
    Array.update (r, (i - 1) + (n * (j - 1)), x)

end

(*------------------------------------------------------------------*)

(* A vertex is, internally, a positive integer, or 0 for the nil
   object. *)

signature VERTEX =
sig
  exception VertexError
  eqtype vertex
  val nilVertex : vertex
  val isNil : vertex -> bool
  val max : vertex * vertex -> vertex
  val toInt : vertex -> int
  val fromInt : int -> vertex
  val toString : vertex -> string
  val directedListToString : vertex list -> string
end

structure Vertex : VERTEX =
struct

exception VertexError

type vertex = int

val nilVertex = 0

fun isNil u = u = nilVertex
fun max (u, v) = Int.max (u, v)
fun toInt u = u

fun fromInt i =
    if i < nilVertex then
      raise VertexError
    else
      i

fun toString u = Int.toString u

fun directedListToString [] = ""
  | directedListToString [u] = toString u
  | directedListToString (u :: tail) =
    (* This implementation is *not* tail recursive. *)
    (toString u) ^ " -> " ^ (directedListToString tail)

end

(*------------------------------------------------------------------*)

(* Graph edges, with weights. *)

signature EDGE =
sig
  type edge
  val make : Vertex.vertex * real * Vertex.vertex -> edge
  val first : edge -> Vertex.vertex
  val weight : edge -> real
  val second : edge -> Vertex.vertex
end

structure Edge : EDGE =
struct

type edge = Vertex.vertex * real * Vertex.vertex

fun make edge = edge
fun first (u, _, _) = u
fun weight (_, w, _) = w
fun second (_, _, v) = v

end

(*------------------------------------------------------------------*)

(* The "dist" array and its operations. *)

signature DISTANCES =
sig
  type distances
  val make : int -> distances
  val get : distances -> int * int -> real
  val set : distances -> int * int -> real -> unit
end

structure Distances : DISTANCES =
struct

type distances = real SquareArray.squareArray

fun make n = SquareArray.make (n, Real.posInf)
val get = SquareArray.get
val set = SquareArray.set

end

(*------------------------------------------------------------------*)

(* The "next" array and its operations. It lets you look up optimum
   paths. *)

signature PATHS =
sig
  type paths
  val make : int -> paths
  val get : paths -> int * int -> Vertex.vertex
  val set : paths -> int * int -> Vertex.vertex -> unit
  val path : (paths * int * int) -> Vertex.vertex list
  val pathString : (paths * int * int) -> string
end

structure Paths : PATHS =
struct

type paths = Vertex.vertex SquareArray.squareArray

fun make n = SquareArray.make (n, Vertex.nilVertex)
val get = SquareArray.get
val set = SquareArray.set

fun path (p, u, v) =
    if Vertex.isNil (get p (u, v)) then
      []
    else
      let
        fun
        build_path (p, u, v) =
        if u = v then
          [v]
        else
          let
            val i = get p (u, v)
          in
            u :: build_path (p, i, v)
          end
      in
        build_path (p, u, v)
      end

fun pathString (p, u, v) =
    Vertex.directedListToString (path (p, u, v))

end

(*------------------------------------------------------------------*)

(* Floyd-Warshall. *)

exception FloydWarshallError

fun find_max_vertex [] = Vertex.nilVertex
  | find_max_vertex (edge :: tail) =
    (* This implementation is *not* tail recursive. *)
    Vertex.max (Vertex.max (Edge.first edge, Edge.second edge),
                find_max_vertex tail)

fun floyd_warshall [] = raise FloydWarshallError
  | floyd_warshall edges =
    let
      val n = find_max_vertex edges
      val dist = Distances.make n
      val next = Paths.make n

      fun read_edges [] = ()
        | read_edges (edge :: tail) =
          let
            val u = Edge.first edge
            val v = Edge.second edge
            val weight = Edge.weight edge
          in
            (Distances.set dist (u, v) weight;
             Paths.set next (u, v) v;
             read_edges tail)
          end

      val indices =
          (* Indices in order from 1 .. n. *)
          List.tabulate (n, fn i => i + 1)
    in

      (* Initialization. *)

      read_edges edges;
      List.app (fn i => (Distances.set dist (i, i) 0.0;
                         Paths.set next (i, i) i))
               indices;

      (* Perform the algorithm. *)

      List.app
        (fn k =>
            List.app
              (fn i =>
                  List.app
                    (fn j =>
                        let
                          val dist_ij = Distances.get dist (i, j)
                          val dist_ik = Distances.get dist (i, k)
                          val dist_kj = Distances.get dist (k, j)
                          val dist_ikj = dist_ik + dist_kj
                        in
                          if dist_ikj < dist_ij then
                            let
                              val new_dist = dist_ikj
                              val new_next = Paths.get next (i, k)
                            in
                              Distances.set dist (i, j) new_dist;
                              Paths.set next (i, j) new_next
                            end
                          else
                            ()
                        end)
                    indices)
              indices)
        indices;

      (* Return the results, as a 3-tuple. *)

      (n, dist, next)

    end

(*------------------------------------------------------------------*)

fun tilde_to_minus s =
    String.translate (fn c => if c = #"~" then "-" else str c) s

fun main () =
    let
      val example_graph =
          [Edge.make (Vertex.fromInt 1, ~2.0, Vertex.fromInt 3),
           Edge.make (Vertex.fromInt 3, 2.0, Vertex.fromInt 4),
           Edge.make (Vertex.fromInt 4, ~1.0, Vertex.fromInt 2),
           Edge.make (Vertex.fromInt 2, 4.0, Vertex.fromInt 1),
           Edge.make (Vertex.fromInt 2, 3.0, Vertex.fromInt 3)]

      val (n, dist, next) = floyd_warshall example_graph

      val indices =
          (* Indices in order from 1 .. n. *)
          List.tabulate (n, fn i => i + 1)
    in
      print "  pair     distance    path\n";
      print "---------------------------------------\n";
      List.app
        (fn u =>
            List.app
              (fn v =>
                  if u <> v then
                    (print " ";
                     print (Vertex.directedListToString [u, v]);
                     print "     ";
                     if 0.0 <= Distances.get dist (u, v) then
                       print " "
                     else
                       ();
                     print (tilde_to_minus
                              (Real.fmt (StringCvt.FIX (SOME 1))
                                        (Distances.get dist (u, v))));
                     print "      ";
                     print (Paths.pathString (next, u, v));
                     print "\n")
                  else
                    ())
              indices)
        indices
    end;

(* Comment out the following line, if you are using Poly/ML. *)
main ();

(*------------------------------------------------------------------*)
(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)


package require Tcl 8.5     ;# for {*} and [dict]
package require struct::graph
package require struct::graph::op

struct::graph g

set arclist {
    a b
    a p
    b m
    b c
    c d
    d e
    e f
    f q
    f g
}

g node insert {*}$arclist

foreach {from to} $arclist {
    set a [g arc insert $from $to]
    g arc setweight $a 1.0
}

set paths [::struct::graph::op::FloydWarshall g]

set paths [dict filter $paths key {a *}]        ;# filter for paths starting at "a"
set paths [dict filter $paths value {[0-9]*}]   ;# whose cost is not "Inf"
set paths [lsort -stride 2 -index 1 -real -decreasing $paths]   ;# and print the longest first
puts $paths


package main

import (
    "fmt"
    "log"
    "os"
    "os/exec"
)

func reverseBytes(bytes []byte) {
    for i, j := 0, len(bytes)-1; i < j; i, j = i+1, j-1 {
        bytes[i], bytes[j] = bytes[j], bytes[i]
    }
}

func check(err error) {
    if err != nil {
        log.Fatal(err)
    }
}

func main() {
    in, err := os.Open("infile.dat")
    check(err)
    defer in.Close()

    out, err := os.Create("outfile.dat")
    check(err)

    record := make([]byte, 80)
    empty := make([]byte, 80)
    for {
        n, err := in.Read(record)
        if err != nil {
            if n == 0 {
                break // EOF reached
            } else {
                out.Close()
                log.Fatal(err)
            }
        }
        reverseBytes(record)
        out.Write(record)
        copy(record, empty)
    }
    out.Close()

    // Run dd from within program to write output.dat
    // to standard output as normal text with newlines.
    cmd := exec.Command("dd", "if=outfile.dat", "cbs=80", "conv=unblock")
    bytes, err := cmd.Output()
    check(err)
    fmt.Println(string(bytes))
}


using System;
using System.Text;

public class FloydsTriangle
{
    internal static void Main(string[] args)
    {
        int count;
        if (args.Length >= 1 && int.TryParse(args[0], out count) && count > 0)
        {
            Console.WriteLine(MakeTriangle(count));
        }
        else
        {
            Console.WriteLine(MakeTriangle(5));
            Console.WriteLine();
            Console.WriteLine(MakeTriangle(14));
        }
    }

    public static string MakeTriangle(int rows)
    {
        int maxValue = (rows * (rows + 1)) / 2;
        int digit = 0;
        StringBuilder output = new StringBuilder();

        for (int row = 1; row <= rows; row++)
        {
            for (int column = 0; column < row; column++)
            {
                int colMaxDigit = (maxValue - rows) + column + 1;
                if (column > 0)
                {
                    output.Append(' ');
                }

                digit++;
                output.Append(digit.ToString().PadLeft(colMaxDigit.ToString().Length));
            }

            output.AppendLine();
        }

        return output.ToString();
    }
}


Module Module1

    Sub PrintResult(dist As Double(,), nxt As Integer(,))
        Console.WriteLine("pair     dist    path")
        For i = 1 To nxt.GetLength(0)
            For j = 1 To nxt.GetLength(1)
                If i <> j Then
                    Dim u = i
                    Dim v = j
                    Dim path = String.Format("{0} -> {1}    {2,2:G}     {3}", u, v, dist(i - 1, j - 1), u)
                    Do
                        u = nxt(u - 1, v - 1)
                        path += String.Format(" -> {0}", u)
                    Loop While u <> v
                    Console.WriteLine(path)
                End If
            Next
        Next
    End Sub

    Sub FloydWarshall(weights As Integer(,), numVerticies As Integer)
        Dim dist(numVerticies - 1, numVerticies - 1) As Double
        For i = 1 To numVerticies
            For j = 1 To numVerticies
                dist(i - 1, j - 1) = Double.PositiveInfinity
            Next
        Next

        For i = 1 To weights.GetLength(0)
            dist(weights(i - 1, 0) - 1, weights(i - 1, 1) - 1) = weights(i - 1, 2)
        Next

        Dim nxt(numVerticies - 1, numVerticies - 1) As Integer
        For i = 1 To numVerticies
            For j = 1 To numVerticies
                If i <> j Then
                    nxt(i - 1, j - 1) = j
                End If
            Next
        Next

        For k = 1 To numVerticies
            For i = 1 To numVerticies
                For j = 1 To numVerticies
                    If dist(i - 1, k - 1) + dist(k - 1, j - 1) < dist(i - 1, j - 1) Then
                        dist(i - 1, j - 1) = dist(i - 1, k - 1) + dist(k - 1, j - 1)
                        nxt(i - 1, j - 1) = nxt(i - 1, k - 1)
                    End If
                Next
            Next
        Next

        PrintResult(dist, nxt)
    End Sub

    Sub Main()
        Dim weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
        Dim numVeritices = 4

        FloydWarshall(weights, numVeritices)
    End Sub

End Module


   _80 ]\ fread 'flr-infile.dat'   NB. reads the file into a n by 80 array
   _80 |.\ fread 'flr-infile.dat'  NB. as above but reverses each 80 byte chunk
   'flr-outfile.dat' fwrite~ , _80 |.\ fread 'flr-infile.dat'  NB. as above but writes result to file (720 bytes)
   processFixLenFile=: fwrite~ [: , _80 |.\ fread              NB. represent operation as a verb/function


function processfixedlengthrecords(infname, blocksize, outfname)
    inf = open(infname)
    outf = open(outfname, "w")
    filedata = [ read(inf, blocksize) for _ in 1:10 ]

    for line in filedata
        s = join([Char(c) for c in line], "")
        @assert(length(s) == blocksize)
        write(outf, s)
    end
end

processfixedlengthrecords("infile.dat", 80, "outfile.dat")


-- prep: convert given sample text to fixed length "infile.dat"
local sample = [[
Line 1...1.........2.........3.........4.........5.........6.........7.........8
Line 2
Line 3
Line 4

Line 6
Line 7
     Indented line 8............................................................
Line 9                                                                 RT MARGIN]]
local txtfile = io.open("sample.txt", "w")
txtfile:write(sample)
txtfile:close()
os.execute("dd if=sample.txt of=infile.dat cbs=80 conv=block > /dev/null 2>&1")

-- task: convert fixed length "infile.dat" to fixed length "outfile.dat" (reversed lines)
local infile = io.open("infile.dat", "rb")
local outfile = io.open("outfile.dat", "wb")
while true do
  local line = infile:read(80)
  if not line then break end
  outfile:write(string.reverse(line))
end
infile:close()
outfile:close()

-- output:
os.execute("dd if=outfile.dat cbs=80 conv=unblock")


Module FixedFile {
      Read fixed$
      OldLocale=Locale
      \\ chr$(string_argument$)
      \\ use Locale to convert from Ansi to Utf-16LE
      \\ Read Ansi form files also use Locale
      Locale 1032
      Try ok {
            \\ Make the file first
            Const Center=2
            Font "Courier New"
            Bold 0
            Italic 0
            Def long m, z=1, f
            Def text2read$,test3write$
            Form 100, 50  ' 100 by 60 characters
            Document txt$={Line 1...1.........2.........3.........4.........5.........6.........7.........8
                  Line 2
                  Line 3
                  Line 4

                  Line 6
                  Line 7
                       Indented line 8............................................................
                  Line 9                                                                 RT MARGIN
                  }
            \\ use Help Open in M2000 console for details
            \\ Method one
            Report Center,  "Make file"
            \\ for WIDE Random \\  for Utf-16
            Open fixed$ for Random Exclusive as #f len=80
            m=Paragraph(txt$, 0)
            z=1
            If forward(txt$, m) then
                  while m, z<10
                        text2write$=Paragraph$(txt$,(m))
                        Print format$("Len:{0}, Data: {1}",Len(text2write$),text2write$)
                        Put #f, text2write$ , z
                        \\ record number from 1
                        \\ if number is total records plus one
                        \\ we append a record
                        z++
                  End while
            End If
            Print "Press any key"
            Push Key$ : Drop
            Form 80, 40
            Report Center,  "Method1"
            For z=1 to 9
                  Get #f, text2read$, z
                  text2read$=StrRev$(text2read$)
                  Put #f, text2read$, z
                  Print text2read$
            Next z
            Close #f
            Report Center,  "Method2"
            \\ Method2
            \\ Buffer Clear Line80 ... \\ to clear memory
            \\ here we write all bytes so not needed
            Buffer Line80 as byte*80
            m=filelen(fixed$)
            If m mod 80=0 Then
                  m=1
                  \\ now Get/Put read write at byte position
                  \\ we have to use seek to move to byte position
                  \\ This way used for Binary files
                  Open fixed$ for Input as #f1
                  Open fixed$ for Append as #f2
                  while not eof(#f1)
                        seek #f1, m
                        Rem Print seek(#f)
                        Get #f1, Line80
                        Return line80,0:=Str$(StrRev$(Chr$(Eval$(line80,0,80))))
                        seek #f2, m
                        Put #f2, Line80
                        seek #f1, m
                        Get #f1, Line80
                        Print Chr$(Eval$(line80,0,80))
                        m+=80
                  End While
                  Close #f1
                  Close #f2
            End if
      }
      \\ use Close with no parameters for close all files if something happen
      If error then Close: Print Error$
      Locale OldLocale
}
FixedFile "fixed.random"


FixedRecordReverse[inFile_File, outFile_File, length_ : 80] :=
  Module[{inStream, outStream, line, byte},
    WithCleanup[
      inStream = OpenRead[inFile, BinaryFormat -> True];
      outStream = OpenWrite[outFile, BinaryFormat -> True];
    ,
      While[True,
        line = {};
        Do[
          byte = BinaryRead[inStream, "Byte"];
          AppendTo[line, byte]
        ,
          length
        ];
        If[byte === EndOfFile, Break[]];
        line = Reverse[line];
        BinaryWrite[outStream, line]
      ]
    ,
      Close[outStream];
      Close[inStream];
    ];
    (* Verify the result *)
    RunProcess[{"dd", "if=" <> outFile[[1]], "cbs=" <> ToString[length], "conv=unblock"}, "StandardOutput"]
  ];


import "/fmt" for Fmt

class FloydWarshall {
    static doCalcs(weights, nVertices) {
        var dist = List.filled(nVertices, null)
        for (i in 0...nVertices) dist[i] = List.filled(nVertices, 1/0)
        for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2]
        var next = List.filled(nVertices, null)
        for (i in 0...nVertices) next[i] = List.filled(nVertices, 0)
        for (i in 0...next.count) {
            for (j in 0...next.count) {
                if (i != j) next[i][j] = j + 1
            }
        }
        for (k in 0...nVertices) {
            for (i in 0...nVertices) {
                for (j in 0...nVertices) {
                    if (dist[i][k] + dist[k][j] < dist[i][j]) {
                        dist[i][j] = dist[i][k] + dist[k][j]
                        next[i][j] = next[i][k]
                    }
                }
            }
        }
        printResult_(dist, next)
    }

    static printResult_(dist,  next) {
        System.print("pair     dist    path")
        for (i in 0...next.count) {
            for (j in 0...next.count) {
                if (i != j) {
                    var u = i + 1
                    var v = j + 1
                    var path = Fmt.swrite("$d -> $d    $2d     $s", u, v, dist[i][j].truncate, u)
                    while (true) {
                        u = next[u - 1][v - 1]
                        path = path +  " -> " + u.toString
                        if (u == v) break
                    }
                    System.print(path)
                }
            }
        }
    }
}

var weights = [ [1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1] ]
var nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)


/**
 fixed length records, in Neko
*/

var LRECL = 80

var reverse = function(s) {
  var len = $ssize(s)
  if len < 2 return s

  var reverse = $smake(len)
  var pos = 0
  while len > 0 $sset(reverse, pos ++= 1, $sget(s, len -= 1))
  return reverse
}

var file_open = $loader.loadprim("[email protected]_open", 2)
var file_read = $loader.loadprim("[email protected]_read", 4)
var file_write = $loader.loadprim("[email protected]_write", 4)
var file_close = $loader.loadprim("[email protected]_close", 1)

var input = file_open("infile.dat", "r")
var output = file_open("outfile.dat", "w")

var len
var pos = 0
var record = $smake(LRECL)

while true {
  try {
    len = file_read(input, record, pos, LRECL)
    if len != LRECL $throw("Invalid read")

    len = file_write(output, reverse(record), pos, LRECL)
    if len != LRECL $throw("Invalid write")
  } catch a break;
}
file_close(input)
file_close(output)


import algorithm

proc reverse(infile, outfile: string) =

  let input = infile.open(fmRead)
  defer: input.close()
  let output = outfile.open(fmWrite)
  defer: output.close()

  var buffer: array[80, byte]
  while not input.endOfFile:
    let countRead = input.readBytes(buffer, 0, 80)
    if countRead < 80:
      raise newException(IOError, "truncated data when reading")
    buffer.reverse()
    let countWrite = output.writeBytes(buffer, 0, 80)
    if countWrite < 80:
      raise newException(IOError, "truncated data when writing")

reverse("infile.dat", "outfile.dat")


program reverseFixedLines(input, output, stdErr);
const
	lineLength = 80;
var
	// in Pascal, `string[n]` is virtually an alias for `array[1..n] of char`
	line: string[lineLength];
	i: integer;
begin
	while not eof() do
	begin
		for i := 1 to lineLength do
		begin
			read(line[i]);
		end;

		for i := lineLength downto 1 do
		begin
			write(line[i]);
		end;
		writeLn();
	end;
end.


open $in,  '<', 'flr-infile.dat';
open $out, '>', 'flr-outfile.dat';

while ($n=sysread($in, $record, 80)) {   # read in fixed sized binary chunks
     syswrite $out, reverse $record;     # write reversed records to file
     print reverse($record)."\n"         # display reversed records, line-by-line
}
close $out;


(defn TriangleList [n]
  (let [l (map inc (range))]
    (loop [l l x 1 nl []]
      (if (= n (count nl))
        nl
        (recur (drop x l) (inc x) (conj nl (take x l)))))))

(defn TrianglePrint [n]
  (let [t (TriangleList n)
        m (count (str (last (last t))))
        f (map #(map str %) t)
        l (map #(map (fn [x] (if (> m (count x))
                               (str (apply str (take (- m (count x))
                                                     (repeat " "))) x)
                               x)) %) f)
        e (map #(map (fn [x] (str " " x)) %) l)]
    (map #(println (apply str %)) e)))


floyd = cluster is triangle
    rep = null

    width = proc (n: int) returns (int)
        w: int := 1
        while n >= 10 do
            w := w + 1
            n := n / 10
        end
        return (w)
    end width

    triangle = proc (rows: int) returns (string)
        ss: stream := stream$create_output()
        maxno: int := rows * (rows+1)/2
        num: int := 1
        for row: int in int$from_to(1, rows) do
            for col: int in int$from_to(1, row) do
                stream$putright(ss, int$unparse(num), 1 + width(maxno-rows+col))
                num := num + 1
            end
            stream$putl(ss, "")
        end
        return (stream$get_contents(ss))
    end triangle
end floyd

start_up = proc ()
    po: stream := stream$primary_output()
    stream$putl(po, floyd$triangle(5))
    stream$putl(po, floyd$triangle(14))
end start_up


fcn FloydWarshallWithPathReconstruction(dist){ // dist is munged
   V:=dist[0].len();
   next:=V.pump(List,V.pump(List,Void.copy).copy);  // VxV matrix of Void
   foreach u,v in (V,V){ if(dist[u][v]!=Void and u!=v) next[u][v] = v }
   foreach k,i,j in (V,V,V){
      a,b,c:=dist[i][j],dist[i][k],dist[k][j];
      if( (a!=Void and b!=Void and c!=Void and a>b+c) or  // Inf math
      (a==Void and b!=Void and c!=Void) ){
     dist[i][j] = b+c;
     next[i][j] = next[i][k];
      }
   }
   return(dist,next)
}
fcn path(next,u,v){
   if(Void==next[u][v]) return(T);
   path:=List(u);
   while(u!=v){ path.append(u = next[u][v]) }
   path
}
fcn printM(m){ m.pump(Console.println,rowFmt) }
fcn rowFmt(row){ ("%5s "*row.len()).fmt(row.xplode()) }


without js -- file i/o
constant sample_text = """
Line 1...1.........2.........3.........4.........5.........6.........7.........8
Line 2
Line 3
Line 4

Line 6
Line 7
     Indented line 8............................................................
Line 9                                                                 RT MARGIN"""

constant indat = "infile.dat",
         outdat = "outfile.dat"

if not file_exists(indat) then
    object text = get_text("sample.txt")
    if text=-1 then text = sample_text end if
    sequence s = split(text,'\n')
    integer fn = open(indat,"wb")
    for i=1 to length(s) do
        puts(fn,s[i]&repeat(' ',80-length(s[i])))
    end for
    close(fn)
    printf(1,"%s created (%d bytes)\n",{indat,get_file_size(indat)})
end if

function get_block(integer fn, size)
    string res = ""
    for i=1 to size do
        res &= getc(fn)
    end for
    return res
end function

integer fn = open(indat,"rb"),
        isize = get_file_size(indat)
puts(1,"reversed:\n")
for i=1 to isize by 80 do
    ?reverse(get_block(fn,80))
end for
close(fn)

-- Bonus part, 16*64 (=1024) block handling:

procedure put_block(integer fn, sequence lines)
    lines &= repeat("",16-length(lines))
    for i=1 to length(lines) do
        string li = lines[i]
        if length(li)>64 then
            li = li[1..64]
        else
            li &= repeat(' ',64-length(li))
        end if
        puts(fn,li)
    end for
end procedure

fn = open(outdat,"wb")
put_block(fn,split(sample_text,'\n'))
close(fn)
integer osize = get_file_size(outdat)
printf(1,"\n%s created (%d bytes):\n",{outdat,osize})
fn = open(outdat,"rb")
sequence lines = {}
for i=1 to osize by 64 do
    string line = get_block(fn,64)
    ?line
    lines = append(lines,trim_tail(line,' '))
end for
lines = trim_tail(lines,{""})
puts(1,"\ntrimmed:\n")
pp(lines,{pp_Nest,1})
{} = delete_file(indat) -- (for consistent 2nd run)


        IDENTIFICATION DIVISION.
        PROGRAM-ID. FLOYD-TRIANGLE.

        DATA DIVISION.
        WORKING-STORAGE SECTION.
        01 VARIABLES        COMP.
           02 NUM-LINES     PIC 99.
           02 CUR-LINE      PIC 99.
           02 CUR-COL       PIC 99.
           02 CUR-NUM       PIC 999.
           02 ZERO-SKIP     PIC 9.
           02 LINE-PTR      PIC 99.
           02 MAX-NUM       PIC 999.

        01 OUTPUT-FORMAT.
           02 OUT-LINE      PIC X(72).
           02 ONE-DIGIT     PIC B9.
           02 TWO-DIGITS    PIC BZ9.
           02 THREE-DIGITS  PIC BZZ9.
           02 MAX-COL-NUM   PIC 999.

        PROCEDURE DIVISION.
        BEGIN.
            MOVE 5 TO NUM-LINES. PERFORM FLOYD.
            DISPLAY ' '.
            MOVE 14 TO NUM-LINES. PERFORM FLOYD.
            STOP RUN.

        FLOYD.
            MOVE 1 TO CUR-NUM.
            COMPUTE MAX-NUM = NUM-LINES * (NUM-LINES + 1) / 2.
            PERFORM FLOYD-LINE
                VARYING CUR-LINE FROM 1 BY 1
                UNTIL CUR-LINE IS GREATER THAN NUM-LINES.

        FLOYD-LINE.
            MOVE ' ' TO OUT-LINE.
            MOVE 1 TO LINE-PTR.
            PERFORM FLOYD-NUM
                VARYING CUR-COL FROM 1 BY 1
                UNTIL CUR-COL IS GREATER THAN CUR-LINE.
            DISPLAY OUT-LINE.

        FLOYD-NUM.
            COMPUTE MAX-COL-NUM = MAX-NUM - NUM-LINES + CUR-COL.
            MOVE 0 TO ZERO-SKIP.
            INSPECT MAX-COL-NUM TALLYING ZERO-SKIP FOR LEADING '0'.
            IF ZERO-SKIP IS EQUAL TO ZERO
                PERFORM FLOYD-THREE-DIGITS
            ELSE IF ZERO-SKIP IS EQUAL TO 1
                PERFORM FLOYD-TWO-DIGITS
            ELSE IF ZERO-SKIP IS EQUAL TO 2
                PERFORM FLOYD-ONE-DIGIT.
            ADD 1 TO CUR-NUM.

        FLOYD-ONE-DIGIT.
            MOVE CUR-NUM TO ONE-DIGIT.
            STRING ONE-DIGIT DELIMITED BY SIZE INTO OUT-LINE
                WITH POINTER LINE-PTR.

        FLOYD-TWO-DIGITS.
            MOVE CUR-NUM TO TWO-DIGITS.
            STRING TWO-DIGITS DELIMITED BY SIZE INTO OUT-LINE
                WITH POINTER LINE-PTR.

        FLOYD-THREE-DIGITS.
            MOVE CUR-NUM TO THREE-DIGITS.
            STRING THREE-DIGITS DELIMITED BY SIZE INTO OUT-LINE
                WITH POINTER LINE-PTR.


infile = open('infile.dat', 'rb')
outfile = open('outfile.dat', 'wb')

while True:
    onerecord = infile.read(80)
    if len(onerecord) < 80:
        break
    onerecordreversed = bytes(reversed(onerecord))
    outfile.write(onerecordreversed)

infile.close()
outfile.close()


$*OUT = './flr-outfile.dat'.IO.open(:w, :bin) orelse .die; # open a file in binary mode for writing
while my $record = $*IN.read(80) {                       # read in fixed sized binary chunks
     $*OUT.write: $record.=reverse;                      # write reversed records out to $outfile
     $*ERR.say: $record.decode('ASCII');                 # display decoded records on STDERR
}
close $*OUT;


inp: open     %infile.dat
out: open/new %outfile.dat

while [ not empty? line: copy/part inp 80 ][ write out reverse line ]

close inp
close out