langs a-z

Task/Floyds-triangle/NetRexx/floyds-triangle-1.netrexx

@@ -0,0 +1,27 @@
+/* NetRexx */
+options replace format comments java crossref symbols binary
+/* REXX ***************************************************************
+* 12.07.2012 Walter Pachl  - translated from Python
+**********************************************************************/
+Parse Arg rowcount .
+if rowcount.length() == 0 then rowcount = 1
+say 'Rows:' rowcount
+say
+col = 0
+len = Rexx ''
+ll = ''                               -- last line of triangle
+Loop j = rowcount * (rowcount - 1) / 2 + 1 to rowcount * (rowcount + 1) / 2
+  col = col + 1                       -- column number
+  ll = ll j                           -- build last line
+  len[col] = j.length()               -- remember length of column
+  End j
+Loop i = 1 To rowcount - 1            -- now do and output the rest
+  ol = ''
+  col = 0
+  Loop j = i * (i - 1) / 2 + 1 to i * (i + 1) / 2 -- elements of line i
+    col = col + 1
+    ol=ol j.right(len[col])           -- element in proper length
+    end
+  Say ol                              -- output ith line
+  end i
+Say ll                                -- output last line

Task/Floyds-triangle/NetRexx/floyds-triangle-2.netrexx

@@ -0,0 +1,19 @@
+/* NetRexx */
+options replace format comments java crossref symbols binary
+/*REXX program constructs & displays Floyd's triangle for any number of rows.*/
+parse arg numRows .
+if numRows == '' then numRows = 1     -- assume 1 row is not given
+maxVal = numRows * (numRows + 1) % 2  -- calculate the max value.
+say 'displaying a' numRows "row Floyd's triangle:"
+say
+digit = 1
+loop row = 1 for numRows
+  col = 0
+  output = ''
+  loop digit = digit for row
+    col = col + 1
+    colMaxDigit = maxVal - numRows + col
+    output = output Rexx(digit).right(colMaxDigit.length())
+    end digit
+  say output
+  end row

Task/Floyds-triangle/OCaml/floyds-triangle.ocaml

@@ -0,0 +1,26 @@
+let ( |> ) f g x = g (f x)
+let rec last = function x::[] -> x | _::tl -> last tl | [] -> raise Not_found
+let rec list_map2 f l1 l2 =
+  match (l1, l2) with
+  | ([], _) | (_, []) -> []
+  | (x::xs, y::ys) -> (f x y) :: list_map2 f xs ys
+
+let floyd n =
+  let rec aux acc cur len i j =
+    if (List.length acc) = n then (List.rev acc) else
+      if j = len
+      then aux ((List.rev cur)::acc) [] (succ len) i 0
+      else aux acc (i::cur) len (succ i) (succ j)
+  in
+  aux [] [] 1 1 0
+
+let print_floyd f =
+  let lens = List.map (string_of_int |> String.length) (last f) in
+  List.iter (fun row ->
+    print_endline (
+      String.concat " " (
+        list_map2 (Printf.sprintf "%*d") lens row))
+  ) f
+
+let () =
+  print_floyd (floyd (int_of_string Sys.argv.(1)))

Task/Floyds-triangle/OxygenBasic/floyds-triangle.oxy

@@ -0,0 +1,27 @@
+function Floyd(sys n) as string
+sys i,t
+for i=1 to n
+  t+=i
+next
+string s=str t
+sys le=1+len s
+string cr=chr(13,10)
+sys lc=len cr
+string buf=space(le*t+n*lc)
+sys j,o,p=1
+t=0
+for i=1 to n
+  for j=1 to i
+    t++
+    s=str t
+    o=le-len(s)-1 'right justify
+    mid buf,p+o,str t
+    p+=le
+  next
+  mid buf,p,cr
+  p+=lc
+next
+return left buf,p-1
+end function
+
+putfile "s.txt",Floyd(5)+floyd(14)

Task/Floyds-triangle/PL-I/floyds-triangle.pli

@@ -0,0 +1,17 @@
+(fofl, size):
+floyd: procedure options (main); /* Floyd's Triangle. Wiki 12 July 2012 */
+
+   declare (i, m, n) fixed (10), (j, k, w, nr) fixed binary;
+
+   put list ('How many rows do you want?');
+   get list (nr);   /* the number of rows   */
+   n = nr*(nr+1)/2; /* the total number of values */
+
+   j,k = 1; m = n - nr + 1;
+   do i = 1 to n;
+      put edit (i) ( x(1), f(length(trim(m))) );
+      if k > 1 then do; k = k - 1; m = m + 1; end;
+      else do; k,j = j + 1; m = n - nr + 1; put skip; end;
+   end;
+
+end floyd;

Task/Floyds-triangle/Pascal/floyds-triangle.pascal

@@ -0,0 +1,55 @@
+Program FloydDemo (input, output);
+
+function digits(number: integer): integer;
+  begin
+    digits := trunc(ln(number) / ln(10)) + 1;
+  end;
+
+procedure floyd1 (numberOfLines: integer);
+{ variant with repeat .. until loop }
+  var
+    i, j, numbersInLine, startOfLastlLine: integer;
+
+  begin
+    startOfLastlLine := (numberOfLines - 1) * numberOfLines div 2 + 1;
+    i := 1;
+    j := 1;
+    numbersInLine := 1;
+    repeat
+      repeat
+        write(i: digits(startOfLastlLine - 1 + j), ' ');
+        inc(i);
+	inc(j);
+      until (j > numbersInLine);
+      writeln;
+      j := 1;
+      inc(numbersInLine);
+    until (numbersInLine > numberOfLines);
+  end;
+
+procedure floyd2 (numberOfLines: integer);
+{ Variant with for .. do loop }
+  var
+    i, j, numbersInLine, startOfLastlLine: integer;
+
+  begin
+    startOfLastlLine := (numberOfLines - 1) * numberOfLines div 2 + 1;
+    i := 1;
+    for numbersInLine := 1 to numberOfLines do
+    begin
+      for j := 1 to numbersInLine do
+      begin
+        write(i: digits(startOfLastlLine - 1 + j), ' ');
+        inc(i);
+      end;
+      writeln;
+    end;
+  end;
+
+begin
+  writeln ('*** Floyd 5 ***');
+  floyd1(5);
+  writeln;
+  writeln ('*** Floyd 14 ***');
+  floyd2(14);
+end.

Task/Floyds-triangle/Perl-6/floyds-triangle.pl6

@@ -0,0 +1,16 @@
+sub chunk(@flat is copy, *@size) {
+    gather for @size -> $s { take [@flat.shift xx $s] }
+}
+
+constant @floyd = chunk 1..*, 1..*;
+
+sub say-floyd($n) {
+    my @fmt = @floyd[$n-1].map: {"%{.chars}s"}
+
+    for @floyd[^$n] -> @i {
+        say join ' ', (@i Z @fmt).map: -> $i, $f { $i.fmt($f) }
+    }
+}
+
+say-floyd 5;
+say-floyd 14;

Task/Floyds-triangle/PureBasic/floyds-triangle.purebasic

@@ -0,0 +1,50 @@
+Procedure.i sumTo(n)
+  Protected r,i
+  For i=1 To n
+    r+i
+  Next
+  ProcedureReturn r.i
+EndProcedure
+
+; [1]
+; array rsA(n)... string-lengths of the numbers
+; in the bottom row
+
+; [2]
+; sumTo(i-1)+1    to     sumTo(i)
+           ; 11 12 13 14 15
+  ; here k is the column-index for array rsA(k)
+
+Procedure.s FloydsTriangle(n)
+  Protected r.s,s.s,t.s,i,j,k
+  ; [1]
+  Dim rsA(n)
+  i=0
+  For j=sumTo(n-1)+1 To sumTo(n)
+    i+1
+    rsA(i)=Len(Str(j))
+  Next
+  ; [2]
+  For i=1 To n
+    t.s="":k=0
+    For j=sumTo(i-1)+1 To sumTo(i)
+      k+1:t.s+RSet(Str(j),rsA(k)," ")+" "
+    Next
+    r.s+RTrim(t.s)+Chr(13)+Chr(10)
+  Next
+  r.s=Left(r.s,Len(r.s)-2)
+  ProcedureReturn r.s
+EndProcedure
+
+If OpenConsole()
+  n=5
+  r.s=FloydsTriangle(n)
+  PrintN(r.s)
+
+  n=14
+  r.s=FloydsTriangle(n)
+  PrintN(r.s)
+
+  Print(#crlf$ + #crlf$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf

Task/Floyds-triangle/Run-BASIC/floyds-triangle.run

@@ -0,0 +1,8 @@
+input "   Number of rows:"; rows
+for r = 1 to rows    ' r = rows
+  for c = 1 to r     ' c = columns
+    j = j + 1
+    print j;" ";
+  next c
+  print
+next r

Task/Floyds-triangle/XPL0/floyds-triangle.xpl0

@@ -0,0 +1,24 @@
+include c:\cxpl\codes;  \include 'code' declarations
+
+func IntLen(N);         \Return number of digits in a positive integer
+int     N;
+int     I;
+for I:= 1 to 20 do
+    [N:= N/10;  if N=0 then return I];
+
+proc Floyd(N);          \Display Floyd's triangle
+int N;
+int M, Row, Col;
+real F;
+[M:= (N-1+1)*(N-1)/2;   \last Floyd number on second to last row
+F:= 1.0;                \Floyd number counter
+for Row:= 1 to N do
+    [for Col:= 1 to Row do
+        [Format(IntLen(M+Col)+1, 0);  RlOut(0, F);  F:= F+1.0];
+    CrLf(0);
+    ];
+]; \Floyd
+
+[Floyd(5);
+Floyd(14);
+]