[xml]$xml = @'
<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>
'@

foreach ($node in $xml.DocumentElement.ChildNodes) {$node.Name}


Define studentNames.String, src$

src$ = "<Students>"
src$ + "<Student Name='April' Gender='F' DateOfBirth='1989-01-02' />"
src$ + "<Student Name='Bob' Gender='M'  DateOfBirth='1990-03-04' />"
src$ + "<Student Name='Chad' Gender='M'  DateOfBirth='1991-05-06' />"
src$ + "<Student Name='Dave' Gender='M'  DateOfBirth='1992-07-08'>"
src$ + "<Pet Type='dog' Name='Rover' />"
src$ + "</Student>"
src$ + "<Student DateOfBirth='1993-09-10' Gender='F' Name='Émily' />"
src$ + "</Students>"

;This procedure is generalized to match any attribute of any normal element's node name
;i.e. get_values(MainXMLNode(0),"Pet","Type",@petName.String) and displaying petName\s
;would display "dog".
Procedure get_values(*cur_node, nodeName$, attribute$, *valueResults.String)
  ;If nodeName$ and attribute$ are matched then the value
  ;will be added to the string structure pointed to by *valueResults .
  Protected result$

  While *cur_node
    If XMLNodeType(*cur_node) = #PB_XML_Normal

      result$ = GetXMLNodeName(*cur_node)
      If result$ = nodeName$
        If ExamineXMLAttributes(*cur_node)
          While NextXMLAttribute(*cur_node)
            If XMLAttributeName(*cur_node) = attribute$
              If *valueResults <> #Null
                *valueResults\s + XMLAttributeValue(*cur_node) + Chr(13) ;value + carriage-return
              EndIf
            EndIf
          Wend
        EndIf
      EndIf

    EndIf

    get_values(ChildXMLNode(*cur_node), nodeName$, attribute$, *valueResults)
    *cur_node = NextXMLNode(*cur_node)
  Wend
EndProcedure

CatchXML(0,@src$,Len(src$))

If IsXML(0)
  get_values(MainXMLNode(0), "Student", "Name",@studentNames)
  MessageRequester("Student Names", studentNames\s)
  FreeXML(0)
EndIf


import xml.dom.minidom

doc = """<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>"""

doc = xml.dom.minidom.parseString(doc)

for i in doc.getElementsByTagName("Student"):
    print i.getAttribute("Name")


#include <algorithm>
#include <array>
#include <iomanip>
#include <iostream>
#include <sstream>

std::array<std::string, 6> games{ "12", "13", "14", "23", "24", "34" };
std::string results = "000000";

int fromBase3(std::string num) {
    int out = 0;
    for (auto c : num) {
        int d = c - '0';
        out = 3 * out + d;
    }
    return out;
}

std::string toBase3(int num) {
    std::stringstream ss;

    while (num > 0) {
        int rem = num % 3;
        num /= 3;
        ss << rem;
    }

    auto str = ss.str();
    std::reverse(str.begin(), str.end());
    return str;
}

bool nextResult() {
    if (results == "222222") {
        return false;
    }

    auto res = fromBase3(results);

    std::stringstream ss;
    ss << std::setw(6) << std::setfill('0') << toBase3(res + 1);
    results = ss.str();

    return true;
}

int main() {
    std::array<std::array<int, 10>, 4> points;
    for (auto &row : points) {
        std::fill(row.begin(), row.end(), 0);
    }

    do {
        std::array<int, 4> records {0, 0, 0, 0 };

        for (size_t i = 0; i < games.size(); i++) {
            switch (results[i]) {
            case '2':
                records[games[i][0] - '1'] += 3;
                break;
            case '1':
                records[games[i][0] - '1']++;
                records[games[i][1] - '1']++;
                break;
            case '0':
                records[games[i][1] - '1'] += 3;
                break;
            default:
                break;
            }
        }

        std::sort(records.begin(), records.end());
        for (size_t i = 0; i < records.size(); i++) {
            points[i][records[i]]++;
        }
    } while (nextResult());

    std::cout << "POINTS       0    1    2    3    4    5    6    7    8    9\n";
    std::cout << "-------------------------------------------------------------\n";
    std::array<std::string, 4> places{ "1st", "2nd", "3rd", "4th" };
    for (size_t i = 0; i < places.size(); i++) {
        std::cout << places[i] << " place";
        for (size_t j = 0; j < points[i].size(); j++) {
            std::cout << std::setw(5) << points[3 - i][j];
        }
        std::cout << '\n';
    }
    return 0;
}


:- module write_float_arrays.
:- interface.

:- import_module io.

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

:- import_module float, list, math, string.

main(!IO) :-
    io.open_output("filename", OpenFileResult, !IO),
    (
        OpenFileResult = ok(File),
        X = [1.0, 2.0, 3.0, 1e11],
        list.foldl_corresponding(write_dat(File, 3, 5), X, map(sqrt, X), !IO),
        io.close_output(File, !IO)
    ;
        OpenFileResult = error(IO_Error),
        io.stderr_stream(Stderr, !IO),
        io.format(Stderr, "error: %s\n", [s(io.error_message(IO_Error))], !IO),
        io.set_exit_status(1, !IO)
    ).

:- pred write_dat(text_output_stream::in, int::in, int::in, float::in,
     float::in, io::di, io::uo) is det.

write_dat(File, XPrec, YPrec, X, Y, !IO) :-
    io.format(File, "%.*g\t%.*g\n", [i(XPrec), f(X), i(YPrec), f(Y)], !IO).


/* NetRexx */

options replace format comments java crossref savelog symbols nobinary

-- Invent a target text file name based on this program's source file name
parse source . . pgmName '.nrx' .
outFile = pgmName || '.txt'

do
  formatArrays(outFile, [1, 2, 3, 1e+11], [1, 1.4142135623730951, 1.7320508075688772, 316227.76601683791])
catch ex = Exception
  ex.printStackTrace
end

return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- This function formats the input arrays.
--   It has defaults for the x & y precision values of 3 & 5
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method formatArrays(outFile, xf = Rexx[], yf = Rexx[], xprecision = 3, yprecision = 5) -
  public static signals IllegalArgumentException, FileNotFoundException, IOException

  if xf.length > yf.length then signal IllegalArgumentException('Y array must be at least as long as X array')

  fw = BufferedWriter(OutputStreamWriter(FileOutputStream(outFile)))

  loop i_ = 0 to xf.length - 1
    row = xf[i_].format(null, xprecision, null, xprecision).left(15) yf[i_].format(null, yprecision, null, yprecision)
    (Writer fw).write(String row)
    fw.newLine
    end i_
    fw.close

  return


; file:   write-float-array.lsp
; url:    http://rosettacode.org/wiki/Write_float_arrays_to_a_text_file
; author: oofoe 2012-01-30

; The "transpose" function is used to flip the joined lists around so
; that it's easier to iterate through them together.

(define (write-float-array x xp y yp filename)
  (let ((f (format "%%-10.%dg %%-10.%dg" xp yp))
        (o (open filename "write")))
    (dolist (v (transpose (list x y)))
      (write-line o (format f (v 0) (v 1))))
    (close o)
  ))

; Test

(write-float-array
 '(1 2 3 1e11) 3
 '(1 1.4142135623730951 1.7320508075688772 316227.76601683791) 5
 "filename.chan")

(println "File contents:")
(print (read-file "filename.chan"))

(exit)


library(XML)
#Read in XML string
str <- readLines(tc <- textConnection('<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>'))
close(tc)
str


#lang racket
(require xml xml/path)

(define input
#<<END
<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>
END
  )

(define students
  (xml->xexpr
   (document-element
    (read-xml (open-input-string input)))))

(se-path*/list '(Student #:Name) students)


use XML;

my $xml = from-xml '<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>';

say .<Name> for $xml.nodes.grep(/Student/)


import lang::xml::DOM;

public void getNames(loc a){
	D = parseXMLDOM(readFile(a));
	visit(D){
		case element(_,"Student",[_*,attribute(_,"Name", x),_*]): println(x);
	};
}


rebol [
	Title: "XML Reading"
	URL: http://rosettacode.org/wiki/XML_Reading
]

xml: {
<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>
}

; REBOL has a simple built-in XML parser. It's not terribly fancy, but
; it's easy to use. It converts the XML into a nested list of blocks
; which can be accessed using standard REBOL path operators. The only
; annoying part (in this case) is that it does try to preserve
; whitespace, so some of the parsed elements are just things like line
; endings and whatnot, which I need to ignore.

; Once I have drilled down to the individual student records, I can
; just use the standard REBOL 'select' to locate the requested
; property.

data: parse-xml xml
students: data/3/1/3 ; Drill down to student records.
foreach student students [
	if block! = type? student [ ; Ignore whitespace elements.
		print select student/2 "Name"
	]
]


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using static System.Console;
using static System.Linq.Enumerable;

namespace WorldCupGroupStage
{
    public static class WorldCupGroupStage
    {
        static int[][] _histogram;

        static WorldCupGroupStage()
        {
            int[] scoring = new[] { 0, 1, 3 };

            _histogram = Repeat<Func<int[]>>(()=>new int[10], 4).Select(f=>f()).ToArray();

            var teamCombos = Range(0, 4).Combinations(2).Select(t2=>t2.ToArray()).ToList();

            foreach (var results in Range(0, 3).CartesianProduct(6))
            {
                var points = new int[4];

                foreach (var (result, teams) in results.Zip(teamCombos, (r, t) => (r, t)))
                {
                    points[teams[0]] += scoring[result];
                    points[teams[1]] += scoring[2 - result];
                }

                foreach(var (p,i) in points.OrderByDescending(a => a).Select((p,i)=>(p,i)))
                    _histogram[i][p]++;
            }
        }

       // https://gist.github.com/martinfreedman/139dd0ec7df4737651482241e48b062f

       static IEnumerable<IEnumerable<T>> CartesianProduct<T>(this IEnumerable<IEnumerable<T>> seqs) =>
            seqs.Aggregate(Empty<T>().ToSingleton(), (acc, sq) => acc.SelectMany(a => sq.Select(s => a.Append(s))));

       static IEnumerable<IEnumerable<T>> CartesianProduct<T>(this IEnumerable<T> seq, int repeat = 1) =>
            Repeat(seq, repeat).CartesianProduct();

       static IEnumerable<IEnumerable<T>> Combinations<T>(this IEnumerable<T> seq) =>
            seq.Aggregate(Empty<T>().ToSingleton(), (a, b) => a.Concat(a.Select(x => x.Append(b))));

       static IEnumerable<IEnumerable<T>> Combinations<T>(this IEnumerable<T> seq, int numItems) =>
            seq.Combinations().Where(s => s.Count() == numItems);

        private static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }

        static new string ToString()
        {
            var sb = new StringBuilder();

            var range = String.Concat(Range(0, 10).Select(i => $"{i,-3} "));
            sb.AppendLine($"Points      : {range}");

            var u = String.Concat(Repeat("─", 40+13));
            sb.AppendLine($"{u}");

            var places = new[] { "First", "Second", "Third", "Fourth" };
            foreach (var row in _histogram.Select((r, i) => (r, i)))
            {
                sb.Append($"{places[row.i],-6} place: ");
                foreach (var standing in row.r)
                    sb.Append($"{standing,-3} ");
                sb.Append("\n");
            }

            return sb.ToString();
        }

        static void Main(string[] args)
        {
            Write(ToString());
            Read();
        }
    }
}


import strutils, math, sequtils

const OutFileName = "floatarr2file.txt"

const
   XPrecision = 3
   Yprecision = 5

let a = [1.0, 2.0, 3.0, 100_000_000_000.0]
let b = [sqrt(a[0]), sqrt(a[1]), sqrt(a[2]), sqrt(a[3])]
var res = ""
for t in zip(a, b):
    res.add formatFloat(t[0], ffDefault, Xprecision) & "    " &
            formatFloat(t[1], ffDefault, Yprecision) & "\n"

OutFileName.writeFile res
var res2 = OutFileName.readFile()
echo res2


let write_dat filename x y ?(xprec=3) ?(yprec=5) () =
  let oc = open_out filename in
  let write_line a b = Printf.fprintf oc "%.*g\t%.*g\n" xprec a yprec b in
    List.iter2 write_line x y;
    close_out oc


f(x,pr)={
	Strprintf(if(x>=10^pr,
		Str("%.",pr-1,"e")
	,
		Str("%.",pr-#Str(x\1),"f")
	),x)
};
wr(x,y,xprec,yprec)={
	for(i=1,#x,
		write("filename",f(x[i],xprec),"\t",f(y[i],yprec))
	)
};


Program WriteNumbers;

const
  x: array [1..4] of double = (1, 2, 3, 1e11);
  xprecision = 3;
  yprecision = 5;
  baseDigits = 7;

var
  i: integer;
  filename: text;

begin
  assign (filename, 'filename');
  rewrite (filename);
  for i := 1 to 4 do
    writeln (filename, x[i]:baseDigits+xprecision, sqrt(x[i]):baseDigits+yprecision);
  close (filename);
end.


/*REXX program  extracts  student names  from an  XML  string(s).                       */
g.=
g.1 = '<Students>                                                             '
g.2 = '  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />         '
g.3 = '  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />          '
g.4 = '  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />         '
g.5 = '  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">           '
g.6 = '    <Pet Type="dog" Name="Rover" />                                    '
g.7 = '  </Student>                                                           '
g.8 = '  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />  '
g.9 = '</Students>                                                            '

  do j=1  while g.j\==''
  g.j=space(g.j)
  parse var   g.j   'Name="'   studname   '"'
  if studname\==''  then say studname
  end   /*j*/                                    /*stick a fork in it,  we're all done. */


require 'rexml/document'
include REXML

doc = Document.new(File.new("sample.xml"))
# or
# doc = Document.new(xml_string)

# without using xpath
doc.each_recursive do |node|
  puts node.attributes["Name"] if node.name == "Student"
end

# using xpath
doc.each_element("*/Student") {|node| puts node.attributes["Name"]}


' ------------------------------------------------------------------------
'XMLPARSER methods

'#handle ELEMENTCOUNT() - Return the number of child XML elements
'#handle KEY$() 	- Return the key as a string from an XML expression like <key>value</key>
'#handle VALUE$() 	- Return the value as a string from an XML expression like <key>value</key>
'#handle VALUEFORKEY$(keyExpr$) - Return the value for the specified tag key in keyExpr$
'#handle #ELEMENT(n) 	- Return the nth child-element XML element
'#handle #ELEMENT(nameExpr$) - Return the child-element XML element named by nameExpr$
'#handle ATTRIBCOUNT() 	- Return a count of attribute pairs; <a attrA="abc" attrB="def"> has two pairs
'#handle ATTRIBKEY$(n) 	- Return the key string of the nth attribute
'#handle ATTRIBVALUE$(n) - Return the value string of the nth attribute
'#handle ATTRIBVALUE$(n$) - Return the value string of the attribute with the key n$, or an empty string if it doesn't exist.
'#handle ISNULL() 	- Returns zero (or false)
'#handle DEBUG$() 	- Returns the string "Xmlparser"
' ------------------------------------------------------------------------

' The xml string
xml$ = "
<Students>
  <Student Name=""April"" Gender=""F"" DateOfBirth=""1989-01-02"" />
  <Student Name=""Bob"" Gender=""M""  DateOfBirth=""1990-03-04"" />
  <Student Name=""Chad"" Gender=""M""  DateOfBirth=""1991-05-06"" />
  <Student Name=""Dave"" Gender=""M""  DateOfBirth=""1992-07-08"">
    <Pet Type=""dog"" Name=""Rover"" />
  </Student>
  <Student DateOfBirth=""1993-09-10"" Gender=""F"" Name=""Émily"" />
</Students>"

' Creates the xml handler, using the string
xmlparser #spies, xml$

' Uses elementCount() to know how many elements are in betweeb <spies>...</spies>
for count = 1 to #spies elementCount()

  ' Uses "count" to work through the elements, and assigns the element to the
  ' handle "#spy"
  #spy = #spies #element(count)

  ' Prints the value, or inner text, of "#spy": Sam, Clover, & Alex
  print count;" ";#spy value$();" ->";#spy ATTRIBVALUE$(1)

next count


extern crate xml; // provided by the xml-rs crate
use xml::{name::OwnedName, reader::EventReader, reader::XmlEvent};

const DOCUMENT: &str = r#"
<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>
"#;

fn main() -> Result<(), xml::reader::Error> {
    let parser = EventReader::new(DOCUMENT.as_bytes());

    let tag_name = OwnedName::local("Student");
    let attribute_name = OwnedName::local("Name");

    for event in parser {
        match event? {
            XmlEvent::StartElement {
                name,
                attributes,
                ..
            } if name == tag_name => {
                if let Some(attribute) = attributes.iter().find(|&attr| attr.name == attribute_name) {
                    println!("{}", attribute.value);
                }
            }
            _ => (),
        }
    }
    Ok(())
}


(defun histo ()
  (let ((scoring (vector 0 1 3))
        (histo (list (vector 0 0 0 0 0 0 0 0 0 0) (vector 0 0 0 0 0 0 0 0 0 0)
                     (vector 0 0 0 0 0 0 0 0 0 0) (vector 0 0 0 0 0 0 0 0 0 0)))
        (team-combs (vector '(0 1) '(0 2) '(0 3) '(1 2) '(1 3) '(2 3)))
        (single-tupel)
        (sum))
       ; six nested dotimes produces the tupels of the cartesian product of
       ; six lists like '(0 1 2), but without to store all tuples in a list
       (dotimes (x0 3) (dotimes (x1 3) (dotimes (x2 3)
       (dotimes (x3 3) (dotimes (x4 3) (dotimes (x5 3)
           (setf single-tupel (vector x0 x1 x2 x3 x4 x5))
           (setf sum (vector 0 0 0 0))
           (dotimes (i (length single-tupel))
               (setf (elt sum (first (elt team-combs i)))
                     (+ (elt sum (first (elt team-combs i)))
                        (elt scoring (elt single-tupel i))))

               (setf (elt sum (second (elt team-combs i)))
                     (+ (elt sum (second (elt team-combs i)))
                        (elt scoring (- 2 (elt single-tupel i))))))

           (dotimes (i (length (sort sum #'<)))
               (setf (elt (nth i histo) (elt sum i))
                     (1+ (elt (nth i histo) (elt sum i)))))
       ))))))
       (reverse histo)))

; friendly output
(dolist (el (histo))
    (dotimes (i (length el))
        (format t "~3D " (aref el i)))
    (format t "~%"))


use autodie;

sub writedat {
    my ($filename, $x, $y, $xprecision, $yprecision) = @_;

    open my $fh, ">", $filename;

    for my $i (0 .. $#$x) {
        printf $fh "%.*g\t%.*g\n", $xprecision||3, $x->[$i], $yprecision||5, $y->[$i];
    }

    close $fh;
}

my @x = (1, 2, 3, 1e11);
my @y = map sqrt, @x;

writedat("sqrt.dat", \@x, \@y);


(setq *Xprecision 3  *Yprecision 5)

(scl 7)
(mapc
   '((X Y)
      (prinl
         (round X *Xprecision)
         "  "
         (round Y *Yprecision) ) )
   (1.0 2.0 3.0)
   (1.0 1.414213562 1.732050807) )


*Process source attributes xref;
 aaa: Proc Options(main);
 declare X(5) float (9)  initial (1, 2, 3, 4, 5),
         Y(5) float (18) initial (9, 8, 7, 6, 1e9);
 declare (x_precision, y_precision) fixed binary;
 Dcl out stream output;
 open file(out) title('/OUT.TXT,type(text),recsize(100)');
 x_precision = 9;
 y_precision = 16;
 put file(out) edit((X(i),Y(i) do i=1 to 5))
                    (skip,e(19,x_precision),
                     x(2),e(24,y_precision));
 end;


val students =
  <Students>
    <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
    <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
    <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
    <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
      <Pet Type="dog" Name="Rover" />
    </Student>
    <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
  </Students>

students \ "Student" \\ "@Name" foreach println


require('XML::Simple');

var ref = %S'XML::Simple'.XMLin('<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
</Students>');

ref{:Student}.each { say _{:Name} };


slate[1]> [ |tree|

  tree: (Xml SimpleParser newOn: '<Students>
    <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
    <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
    <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
    <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
      <Pet Type="dog" Name="Rover" />
    </Student>
    <Student DateOfBirth="1993-09-10" Gender="F" Name="Émily" />
  </Students>') parse.
  tree name = 'Students' ifTrue: [(tree children select: #is: `er <- Xml Element)
                                         do: [|:child| child name = 'Student' ifTrue: [inform: (child attributes at: 'Name' ifAbsent: ['Noname'])]]].

] do.
April
Bob
Chad
Dave
Émily
Nil


package require tdom
set tree [dom parse $xml]
set studentNodes [$tree getElementsByTagName Student] ;# or: set studentNodes [[$tree documentElement] childNodes]

foreach node $studentNodes {
    puts [$node getAttribute Name]
}


void main() {
    import std.stdio, std.range, std.array, std.algorithm, combinations3;

    immutable scoring = [0, 1, 3];
    /*immutable*/ auto r3 = [0, 1, 2];
    immutable combs = 4.iota.array.combinations(2).array;
    uint[10][4] histo;

    foreach (immutable results; cartesianProduct(r3, r3, r3, r3, r3, r3)) {
        int[4] s;
        foreach (immutable r, const g; [results[]].zip(combs)) {
            s[g[0]] += scoring[r];
            s[g[1]] += scoring[2 - r];
        }

        foreach (immutable i, immutable v; s[].sort().release)
            histo[i][v]++;
    }
    writefln("%(%s\n%)", histo[].retro);
}


import system'routines;
import extensions;

public singleton program
{
    static games := new string[]{"12", "13", "14", "23", "24", "34"};

    static results := "000000";

    nextResult()
    {
        var s := results;

        if (results=="222222") { ^ false };

        results := (results.toInt(3) + 1).toString(3).padLeft($48, 6);

        ^ true
    }

    closure()
    {
        var points := IntMatrix.allocate(4, 10);

        int counter := 0;
        do
        {
            var records := new int[]{0,0,0,0};

            for(int i := 0, i < 6, i += 1)
            {
                var r := results[i];
                r =>
                    "2" { records[games[i][0].toInt() - 49] := records[games[i][0].toInt() - 49] + 3 }
                    "1" {
                        records[games[i][0].toInt() - 49] := records[games[i][0].toInt() - 49] + 1;
                        records[games[i][1].toInt() - 49] := records[games[i][1].toInt() - 49] + 1
                    }
                    "0" { records[games[i][1].toInt() - 49] := records[games[i][1].toInt() - 49] + 3 };
            };

            records := records.ascendant();

            for(int i := 0, i <= 3, i += 1)
                {
                    points[i][records[i]] := points[i][records[i]] + 1
                }
        }
        while(program.nextResult());

        new Range(0, 4).zipForEach(new string[]{"1st", "2nd", "3rd", "4th"}, (i,l)
        {
            console.printLine(l,": ", points[3 - i].toArray())
        });
    }
}


defmodule World_Cup do
  def group_stage do
    results = [[3,0],[1,1],[0,3]]
    teams = [0,1,2,3]
    allresults = combos(2,teams) |> combinations(results)
    allpoints = for list <- allresults, do: (for {l1,l2} <- list, do: Enum.zip(l1,l2)) |> List.flatten
    totalpoints = for list <- allpoints, do: (for t <- teams, do: {t, Enum.sum(for {t_,points} <- list, t_==t, do: points)} )
    sortedtotalpoints = for list <- totalpoints, do: Enum.sort(list,fn({_,a},{_,b}) -> a > b end)
    pointsposition = for n <- teams, do: (for list <- sortedtotalpoints, do: elem(Enum.at(list,n),1))
    for n <- teams do
      for points <- 0..9 do
        Enum.at(pointsposition,n) |> Enum.filter(&(&1 == points)) |> length
      end
    end
  end

  defp combos(1, list), do: (for x <- list, do: [x])
  defp combos(k, list) when k == length(list), do: [list]
  defp combos(k, [h|t]) do
    (for subcombos <- combos(k-1, t), do: [h | subcombos]) ++ (combos(k, t))
  end

  defp combinations([h],list2), do: (for item <- list2, do: [{h,item}])
  defp combinations([h|t],list2) do
    for item <- list2, comb <- combinations(t,list2), do: [{h,item} | comb]
  end
end

format = String.duplicate("~4w", 10) <> "~n"
:io.format(format, Enum.to_list(0..9))
IO.puts String.duplicate(" ---", 10)
Enum.each(World_Cup.group_stage, fn x -> :io.format(format, x) end)


#Size = 4

DataSection
  Data.f 1, 2, 3, 1e11 ;x values, how many values needed is determined by #Size
EndDataSection

Dim x.f(#Size - 1)
Dim y.f(#Size - 1)

Define i
For i = 0 To #Size - 1
  Read.f x(i)
  y(i) = Sqr(x(i))
Next

Define file$, fileID, xprecision = 3, yprecision = 5, output$

file$ = SaveFileRequester("Text file for float data", "xydata.txt","Text file | *.txt", 0)
If file$
  fileID = OpenFile(#PB_Any, file$)
  If fileID
    For i = 0 To #Size - 1
      output$ = StrF(x(i), xprecision) + Chr(9) + StrF(y(i), yprecision)
      WriteStringN(fileID, output$)
    Next
    CloseFile(fileID)
  EndIf
EndIf


import itertools
def writedat(filename, x, y, xprecision=3, yprecision=5):
    with open(filename,'w') as f:
        for a, b in itertools.izip(x, y):
            print >> f, "%.*g\t%.*g" % (xprecision, a, yprecision, b)


$$ MODE TUSCRIPT
MODE DATA
$$ SET xmldata =*
<Students>
  <Student Name="April" Gender="F" DateOfBirth="1989-01-02" />
  <Student Name="Bob" Gender="M"  DateOfBirth="1990-03-04" />
  <Student Name="Chad" Gender="M"  DateOfBirth="1991-05-06" />
  <Student Name="Dave" Gender="M"  DateOfBirth="1992-07-08">
    <Pet Type="dog" Name="Rover" />
  </Student>
  <Student DateOfBirth="1993-09-10" Gender="F" Name="Emily" />
</Students>
$$ MODE TUSCRIPT
COMPILE
LOOP x = xmldata
SET name=GET_TAG_NAME (x)
IF (name!="student") CYCLE
 studentname=GET_ATTRIBUTE (x,"Name")
 IF (studentname!="") PRINT studentname
ENDLOOP
ENDCOMPILE


<Students>
@(collect :vars (NAME GENDER YEAR MONTH DAY (PET_TYPE "none") (PET_NAME "")))
@  (cases)
  <Student Name="@NAME" Gender="@GENDER" DateOfBirth="@[email protected]@DAY"@(skip)
@  (or)
  <Student DateOfBirth="@[email protected]@DAY" Gender="@GENDER" Name="@NAME"@(skip)
@  (end)
@  (maybe)
    <Pet Type="@PET_TYPE" Name="@PET_NAME" />
@  (end)
@(until)
</Students>
@(end)
@(output :filter :from_html)
NAME         G DOB        PET
@  (repeat)
@{NAME 12} @GENDER @[email protected]@DAY @PET_TYPE @PET_NAME
@  (end)
@(end)


Option Explicit

Const strXml As String = "" & _
"<Students>" & _
    "<Student Name=""April"" Gender=""F"" DateOfBirth=""1989-01-02"" />" & _
    "<Student Name=""Bob"" Gender=""M""  DateOfBirth=""1990-03-04"" />" & _
    "<Student Name=""Chad"" Gender=""M""  DateOfBirth=""1991-05-06"" />" & _
    "<Student Name=""Dave"" Gender=""M""  DateOfBirth=""1992-07-08"">" & _
        "<Pet Type=""dog"" Name=""Rover"" />" & _
    "</Student>" & _
    "<Student DateOfBirth=""1993-09-10"" Gender=""F"" Name=""Émily"" />" & _
"</Students>"

Sub Main_Xml()
Dim MyXml As Object
Dim myNodes, myNode

    With CreateObject("MSXML2.DOMDocument")
        .LoadXML strXml
        Set myNodes = .getElementsByTagName("Student")
    End With
    If Not myNodes Is Nothing Then
        For Each myNode In myNodes
            Debug.Print myNode.getAttribute("Name")
        Next
    End If
    Set myNodes = Nothing
End Sub


Repeat(ALL) {
    Search("<Student|X", ERRBREAK)
    #1 = Cur_Pos
    Match_Paren()
    if (Search_Block(/Name=|{",'}/, #1, Cur_Pos, BEGIN+ADVANCE+NOERR+NORESTORE)==0) { Continue }
    #2 = Cur_Pos
    Search(/|{",'}/)
    Type_Block(#2, Cur_Pos)
    Type_Newline
}


-module(world_cup).

-export([group_stage/0]).

group_stage() ->
	Results = [[3,0],[1,1],[0,3]],
	Teams = [1,2,3,4],
	Matches = combos(2,Teams),
	AllResults =
		combinations(Matches,Results),
	AllPoints =
		[lists:flatten([lists:zip(L1,L2) || {L1,L2} <- L]) || L <- AllResults],
	TotalPoints =
		[ [ {T,lists:sum([Points || {T_,Points} <- L, T_ == T])} || T <- Teams] || L <- AllPoints],
	SortedTotalPoints =
		[ lists:sort(fun({_,A},{_,B}) -> A > B end,L) || L <- TotalPoints],
	PointsPosition =
		[ [element(2,lists:nth(N, L))|| L <- SortedTotalPoints ] || N <- Teams],
	[ [length(lists:filter(fun(Points_) -> Points_ == Points end,lists:nth(N, PointsPosition) ))
		|| Points <- lists:seq(0,9)] || N <- Teams].

combos(1, L) ->
	[[X] || X <- L];
combos(K, L) when K == length(L) ->
	[L];
combos(K, [H|T]) ->
    [[H | Subcombos] || Subcombos <- combos(K-1, T)]
    ++ (combos(K, T)).

combinations([H],List2) ->
	[[{H,Item}] || Item <- List2];
combinations([H|T],List2) ->
	[ [{H,Item} | Comb] || Item <- List2, Comb <- combinations(T,List2)].


writexy <- function(file, x, y, xprecision=3, yprecision=3) {
  fx <- formatC(x, digits=xprecision, format="g", flag="-")
  fy <- formatC(y, digits=yprecision, format="g", flag="-")
  dfr <- data.frame(fx, fy)
  write.table(dfr, file=file, sep="\t", row.names=F, col.names=F, quote=F)
}

x <- c(1, 2, 3, 1e11)
y <- sqrt(x)
writexy("test.txt", x, y, yp=5)


#lang racket

(define xs '(1.0 2.0 3.0 1.0e11))
(define ys '(1.0 1.4142135623730951 1.7320508075688772 316227.76601683791))

(define xprecision 3)
(define yprecision 5)

(with-output-to-file "some-file" #:exists 'truncate
  (λ() (for ([x xs] [y ys])
         (displayln (~a (~r x #:precision xprecision)
                    "  "
                    (~r y #:precision yprecision))))))

#|
The output is not using exponenets as above, but that's not needed
since Racket can read these numbers fine:

1  1
2  1.41421
3  1.73205
100000000000  316227.76602
|#


sub writefloat ( $filename, @x, @y, $x_precision = 3, $y_precision = 5 ) {
    my $fh = open $filename, :w;
    for flat @x Z @y -> $x, $y {
        $fh.printf: "%.*g\t%.*g\n", $x_precision, $x, $y_precision, $y;
    }
    $fh.close;
}

my @x = 1, 2, 3, 1e11;
my @y = @x.map({.sqrt});

writefloat( 'sqrt.dat', @x, @y );


3 as $xprecision
5 as $yprecision

[ ] as $results

[ 1 2 3 1e11 ] as $a

group
   $a each sqrt
list as $b

# generate format specifier   "%-8.3g %.5g\n"
"%%-8.%($xprecision)dg %%.%($yprecision)dg\n" as $f

define print2 use $v1, $v2, $f
   $v2 1.0 prefer  $v1 1.0 prefer $f format $results push

4 each as $i
   $f $b $i get $a $i get print2
$results "" join "results.dat" write


/*REXX program writes  two arrays  to a file  with a  specified (limited)  precision.   */
numeric digits 1000                              /*allow use of a huge number of digits.*/
oFID= 'filename'                                 /*name of the  output  File IDentifier.*/
x.=;  y.=;                     x.1= 1    ;    y.1=      1
                               x.2= 2    ;    y.2=      1.4142135623730951
                               x.3= 3    ;    y.3=      1.7320508075688772
                               x.4= 1e11 ;    y.4= 316227.76601683791
xPrecision= 3                                    /*the precision for the   X   numbers. */
yPrecision= 5                                    /* "      "      "   "    Y      "     */
                do j=1  while  x.j\==''          /*process and reformat all the numbers.*/
                newX=rule(x.j, xPrecision)       /*format  X  numbers with new precision*/
                newY=rule(y.j, yPrecision)       /*   "    Y     "      "   "      "    */
                aLine=translate(newX || left('',4) || newY,   "e",  'E')
                say aLine                        /*display re─formatted numbers ──► term*/
                call lineout oFID, aLine         /*write         "         "     "  disk*/
                end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
rule: procedure;   parse arg z 1 oz,p;     numeric digits p;       z=format(z,,p)
      parse var z  mantissa      'E'  exponent                /*get the dec dig exponent*/
      parse var    mantissa int  '.'  fraction                /* "  integer and fraction*/
                             fraction=strip(fraction, 'T', 0) /*strip  trailing  zeroes.*/
      if fraction\==''  then fraction="."fraction             /*any fractional digits ? */
      if exponent\==''  then exponent="E"exponent             /*in exponential format ? */
      z=int || fraction || exponent                           /*format #  (as per rules)*/
      if datatype(z,'W')  then return format(oz/1,,0)         /*is it a whole number ?  */
                               return format(oz/1,,,3,0)      /*3 dec. digs in exponent.*/


Dim xml = <Students>
              <Student Name="April"/>
              <Student Name="Bob"/>
              <Student Name="Chad"/>
              <Student Name="Dave"/>
              <Student Name="Emily"/>
           </Students>

Dim names = (From node In xml...<Student> Select node.@Name).ToArray

For Each name In names
     Console.WriteLine(name)
Next


import "/pattern" for Pattern
import "/fmt" for Conv

var xml =
"<Students>
  <Student Name=\"April\" Gender=\"F\" DateOfBirth=\"1989-01-02\" />
  <Student Name=\"Bob\" Gender=\"M\"  DateOfBirth=\"1990-03-04\" />
  <Student Name=\"Chad\" Gender=\"M\"  DateOfBirth=\"1991-05-06\" />
  <Student Name=\"Dave\" Gender=\"M\"  DateOfBirth=\"1992-07-08\">
    <Pet Type=\"dog\" Name=\"Rover\" />
  </Student>
  <Student DateOfBirth=\"1993-09-10\" Gender=\"F\" Name=\"Émily\" />
</Students>"

var p = Pattern.new("<+1^>>")
var p2 = Pattern.new(" Name/=\"[+1^\"]\"")
var p3 = Pattern.new("/&/#x[+1/h];")
var matches = p.findAll(xml)
for (m in matches) {
    var text = m.text
    if (text.startsWith("<Student ")) {
        var match = p2.find(m.text)
        if (match) {
            var name = match.captures[0].text
            var escapes = p3.findAll(name)
            for (esc in escapes) {
                var hd = esc.captures[0].text
                var char = String.fromCodePoint(Conv.atoi(hd, 16))
                name = name.replace(esc.text, char)
            }
            System.print(name)
        }
    }
}


code ChOut=8, CrLf=9;   \intrinsic routines
string 0;               \use zero-terminated strings

func StrLen(A);         \Return number of characters in an ASCIIZ string
char A;
int  I;
for I:= 0 to -1>>1-1 do
    if A(I) = 0 then return I;

func StrFind(A, B);     \Search for ASCIIZ string A in string B
\Returns address of first occurrence of string A in B, or zero if A is not found
char A, B;              \strings to be compared
int  LA, LB, I, J;
[LA:= StrLen(A);
LB:= StrLen(B);
for I:= 0 to LB-LA do
    [for J:= 0 to LA-1 do
        if A(J) # B(J+I) then J:= LA+1;
    if J = LA then return B+I;  \found
    ];
return 0;
];

char XML, P;
[XML:= "<Students>
        <Student Name=^"April^" Gender=^"F^" DateOfBirth=^"1989-01-02^" />
        <Student Name=^"Bob^" Gender=^"M^" DateOfBirth=^"1990-03-04^" />
        <Student Name=^"Chad^" Gender=^"M^" DateOfBirth=^"1991-05-06^" />
        <Student Name=^"Dave^" Gender=^"M^" DateOfBirth=^"1992-07-08^">
        <Pet Type=^"dog^" Name=^"Rover^" />
        </Student>
        <Student DateOfBirth=^"1993-09-10^" Gender=^"F^" Name=^"Émily^" />
        </Students>";
P:= XML;
loop    [P:= StrFind("<Student ", P);
        if P=0 then quit;
        P:= StrFind("Name=", P);
        if P=0 then quit;
        P:= P + StrLen("Name=x");
        repeat  ChOut(0, P(0));
                P:= P+1;
        until   P(0) = ^";
        CrLf(0);
        ];
]


package main

import (
    "fmt"
    "sort"
    "strconv"
)

var games = [6]string{"12", "13", "14", "23", "24", "34"}
var results = "000000"

func nextResult() bool {
    if results == "222222" {
        return false
    }
    res, _ := strconv.ParseUint(results, 3, 32)
    results = fmt.Sprintf("%06s", strconv.FormatUint(res+1, 3))
    return true
}

func main() {
    var points [4][10]int
    for {
        var records [4]int
        for i := 0; i < len(games); i++ {
            switch results[i] {
            case '2':
                records[games[i][0]-'1'] += 3
            case '1':
                records[games[i][0]-'1']++
                records[games[i][1]-'1']++
            case '0':
                records[games[i][1]-'1'] += 3
            }
        }
        sort.Ints(records[:])
        for i := 0; i < 4; i++ {
            points[i][records[i]]++
        }
        if !nextResult() {
            break
        }
    }
    fmt.Println("POINTS       0    1    2    3    4    5    6    7    8    9")
    fmt.Println("-------------------------------------------------------------")
    places := [4]string{"1st", "2nd", "3rd", "4th"}
    for i := 0; i < 4; i++ {
        fmt.Print(places[i], " place    ")
        for j := 0; j < 10; j++ {
            fmt.Printf("%-5d", points[3-i][j])
        }
        fmt.Println()
    }
}


require'stats'
outcome=: 3 0,1 1,:0 3
pairs=: (i.4) e."1(2 comb 4)
standings=: +/@:>&>,{<"1<"1((i.4) e."1 pairs)#inv"1/ outcome


# Project : Write float arrays to a text file

decimals(13)
x = [1, 2, 3, 100000000000]
y = [1, 1.4142135623730, 1.7320508075688, 316227.76601683]
str = list(4)
fn = "C:\Ring\calmosoft\output.txt"
fp = fopen(fn,"wb")
for i = 1 to 4
     str[i] = string(x[i]) + " | " + string(y[i]) + windowsnl()
     fwrite(fp, str[i])
next
fclose(fp)
fp = fopen("C:\Ring\calmosoft\output.txt","r")
r = ""
while isstring(r)
        r = fgetc(fp)
        if r = char(10) see nl
        else see r ok
end
fclose(fp)


>> x = rand(10,1); y = rand(10,1);
>> writem("mytextfile.txt", [x,y]);


# prepare test data
x = [1, 2, 3, 1e11]
y = x.collect { |xx| Math.sqrt xx }
xprecision = 3
yprecision = 5

# write the arrays
open('sqrt.dat', 'w') do |f|
  x.zip(y) { |xx, yy| f.printf("%.*g\t%.*g\n", xprecision, xx, yprecision, yy) }
end

# print the result file
open('sqrt.dat', 'r') { |f| puts f.read }


student:=RegExp(0'|.*<Student\s*.+Name\s*=\s*"([^"]+)"|);
unicode:=RegExp(0'|.*(&#x[0-9a-fA-F]+;)|);
xml:=File("foo.xml").read();

students:=xml.pump(List,'wrap(line){
   if(student.search(line)){
      s:=student.matched[1];    // ( (match start,len),group text )
      while(unicode.search(s)){ // convert "É" to 0xc9 to UTF-8
	 c:=unicode.matched[1];
	 uc:=c[3,-1].toInt(16).toString(-8);
      	 s=s.replace(c,uc);
      }
      s
   }
   else Void.Skip; // line doesn't contain <Student ... Name ...
});

students.println();


with Ada.Text_IO; use Ada.Text_IO;
procedure Zebra is
   type Content is (Beer, Coffee, Milk, Tea, Water,
      Danish, English, German, Norwegian, Swedish,
      Blue, Green, Red, White, Yellow,
      Blend, BlueMaster, Dunhill, PallMall, Prince,
      Bird, Cat, Dog, Horse, Zebra);
   type Test is (Drink, Person, Color, Smoke, Pet);
   type House is (One, Two, Three, Four, Five);
   type Street is array (Test'Range, House'Range) of Content;
   type Alley is access all Street;

   procedure Print (mat : Alley) is begin
      for H in House'Range loop
         Put(H'Img&": ");
         for T in Test'Range loop
            Put(T'Img&"="&mat(T,H)'Img&" ");
      end loop; New_Line; end loop;
   end Print;

   function FinalChecks (mat : Alley) return Boolean is
      function Diff (A, B : Content; CA , CB : Test) return Integer is begin
         for H1 in House'Range loop for H2 in House'Range loop
               if mat(CA,H1) = A and mat(CB,H2) = B then
                  return House'Pos(H1) - House'Pos(H2);
               end if;
         end loop; end loop;
      end Diff;
   begin
      if abs(Diff(Norwegian, Blue, Person, Color)) = 1
        and Diff(Green, White, Color, Color) = -1
        and abs(Diff(Horse, Dunhill, Pet, Smoke)) = 1
        and abs(Diff(Water, Blend, Drink, Smoke)) = 1
        and abs(Diff(Blend, Cat, Smoke, Pet)) = 1
      then return True;
      end if;
      return False;
   end FinalChecks;

   function Constrained (mat : Alley; atest : Natural) return Boolean is begin
      --  Tests seperated into levels for speed, not strictly necessary
      --  As such, the program finishes in around ~0.02s
      case Test'Val (atest) is
         when Drink => --  Drink
            if mat (Drink, Three) /= Milk then return False; end if;
            return True;
         when Person => --  Drink+Person
            for H in House'Range loop
               if (mat(Person,H) = Norwegian and H /= One)
               or (mat(Person,H) = Danish and mat(Drink,H) /= Tea)
               then return False; end if;
            end loop;
            return True;
         when Color => --  Drink+People+Color
            for H in House'Range loop
               if (mat(Person,H) = English and mat(Color,H) /= Red)
               or (mat(Drink,H) = Coffee and mat(Color,H) /= Green)
               then return False; end if;
            end loop;
            return True;
         when Smoke => --  Drink+People+Color+Smoke
            for H in House'Range loop
               if (mat(Color,H) = Yellow and mat(Smoke,H) /= Dunhill)
               or (mat(Smoke,H) = BlueMaster and mat(Drink,H) /= Beer)
               or (mat(Person,H) = German and mat(Smoke,H) /= Prince)
               then return False; end if;
            end loop;
            return True;
         when Pet => --  Drink+People+Color+Smoke+Pet
            for H in House'Range loop
               if (mat(Person,H) = Swedish and mat(Pet,H) /= Dog)
               or (mat(Smoke,H) = PallMall and mat(Pet,H) /= Bird)
               then return False; end if;
            end loop;
            return FinalChecks(mat); --  Do the next-to checks
      end case;
   end Constrained;

   procedure Solve (mat : Alley; t, n : Natural) is
      procedure Swap (I, J : Natural) is
         temp : constant Content := mat (Test'Val (t), House'Val (J));
      begin
         mat (Test'Val (t), House'Val (J)) := mat (Test'Val (t), House'Val (I));
         mat (Test'Val (t), House'Val (I)) := temp;
      end Swap;
   begin
      if n = 1 and Constrained (mat, t) then --  test t passed
         if t < 4 then Solve (mat, t + 1, 5); --  Onto next test
         else Print (mat); return; --  Passed and t=4 means a solution
         end if;
      end if;
      for i in 0 .. n - 1 loop --  The permutations part
         Solve (mat, t, n - 1);
         if n mod 2 = 1 then Swap (0, n - 1);
         else Swap (i, n - 1); end if;
      end loop;
   end Solve;

   myStreet : aliased Street;
   myAlley : constant Alley := myStreet'Access;
begin
   for i in Test'Range loop for j in House'Range loop --  Init Matrix
      myStreet (i,j) := Content'Val(Test'Pos(i)*5 + House'Pos(j));
   end loop; end loop;
   Solve (myAlley, 0, 5); --  start at test 0 with 5 options
end Zebra;


import java.util.Arrays;

public class GroupStage{
    //team left digit vs team right digit
    static String[] games = {"12", "13", "14", "23", "24", "34"};
    static String results = "000000";//start with left teams all losing

    private static boolean nextResult(){
        if(results.equals("222222")) return false;
        int res = Integer.parseInt(results, 3) + 1;
        results = Integer.toString(res, 3);
        while(results.length() < 6) results = "0" + results;	//left pad with 0s
        return true;
    }

    public static void main(String[] args){
        int[][] points = new int[4][10]; 		//playing 3 games, points range from 0 to 9
        do{
            int[] records = {0,0,0,0};
            for(int i = 0; i < 6; i++){
                switch(results.charAt(i)){
                    case '2': records[games[i].charAt(0) - '1'] += 3; break;    //win for left team
                    case '1':                                                   //draw
                        records[games[i].charAt(0) - '1']++;
                        records[games[i].charAt(1) - '1']++;
                        break;
                    case '0': records[games[i].charAt(1) - '1'] += 3; break;    //win for right team
                }
            }
            Arrays.sort(records);	//sort ascending, first place team on the right
            points[0][records[0]]++;
            points[1][records[1]]++;
            points[2][records[2]]++;
            points[3][records[3]]++;
        }while(nextResult());
        System.out.println("First place: " + Arrays.toString(points[3]));
        System.out.println("Second place: " + Arrays.toString(points[2]));
        System.out.println("Third place: " + Arrays.toString(points[1]));
        System.out.println("Fourth place: " + Arrays.toString(points[0]));
    }
}


import java.io.{File, FileWriter, IOException}

object FloatArray extends App {
  val x: List[Float] = List(1f, 2f, 3f, 1e11f)

  def writeStringToFile(file: File, data: String, appending: Boolean = false) =
    using(new FileWriter(file, appending))(_.write(data))

  def using[A <: {def close() : Unit}, B](resource: A)(f: A => B): B =
    try f(resource) finally resource.close()

  try {
    val file = new File("sqrt.dat")
    using(new FileWriter(file))(writer => x.foreach(x => writer.write(f"$x%.3g\t${math.sqrt(x)}%.5g\n")))
  } catch {
    case e: IOException => println(s"Running Example failed: ${e.getMessage}")
  }
}


$ include "seed7_05.s7i";
  include "float.s7i";
  include "math.s7i";

const proc: main is func
  local
    const array float: numbers is [] (1.0, 2.0, 3.0, 1.0e11);
    var float: aFloat is 0.0;
    var file: aFile is STD_NULL;
  begin
    aFile := open("filename", "w");
    for aFloat range numbers do
      writeln(aFile, aFloat sci 3 exp 2 <& " " <& sqrt(aFloat) sci 5 exp 2);
    end for;
    close(aFile);
  end func;


func writedat(filename, x, y, x_precision=3, y_precision=5) {
    var fh = File(filename).open_w

    for a,b in (x ~Z y) {
        fh.printf("%.*g\t%.*g\n", x_precision, a, y_precision, b)
    }

    fh.close
}

var x = [1, 2, 3, 1e11]
var y = x.map{.sqrt}

writedat('sqrt.dat', x, y)


BEGIN
    # attempt to solve Einstein's Riddle - the Zebra puzzle                     #
    INT unknown   = 0, same    = -1;
    INT english   = 1, swede   = 2, dane  = 3, norwegian   = 4, german = 5;
    INT dog       = 1, birds   = 2, cats  = 3, horse       = 4, zebra  = 5;
    INT red       = 1, green   = 2, white = 3, yellow      = 4, blue   = 5;
    INT tea       = 1, coffee  = 2, milk  = 3, beer        = 4, water  = 5;
    INT pall mall = 1, dunhill = 2, blend = 3, blue master = 4, prince = 5;
    []STRING nationality = ( "unknown", "english",   "swede",   "dane",   "norwegian",   "german" );
    []STRING animal      = ( "unknown", "dog",       "birds",   "cats",   "horse",       "ZEBRA"  );
    []STRING colour      = ( "unknown", "red",       "green",   "white",  "yellow",      "blue"   );
    []STRING drink       = ( "unknown", "tea",       "coffee",  "milk",   "beer",        "water"  );
    []STRING smoke       = ( "unknown", "pall mall", "dunhill", "blend",  "blue master", "prince" );
    MODE HOUSE = STRUCT( INT nationality, animal, colour, drink, smoke );
    # returns TRUE if a field in a house could be set to value, FALSE otherwise #
    PROC can set = ( INT field, INT value )BOOL: field = unknown OR value = same;
    # returns TRUE if the fields of house h could be set to those of            #
    #              suggestion s, FALSE otherwise                                #
    OP   XOR     = ( HOUSE h, HOUSE s )BOOL:
         (   can set( nationality OF h, nationality OF s ) AND can set( animal OF h, animal OF s )
         AND can set( colour      OF h, colour      OF s ) AND can set( drink  OF h, drink  OF s )
         AND can set( smoke       OF h, smoke       OF s )
         ) # XOR # ;
    # sets a field in a house to value if it is unknown                         #
    PROC set     = ( REF INT field, INT value )VOID: IF field = unknown AND value /= same THEN field := value FI;
    # sets the unknown fields in house h to the non-same fields of suggestion s #
    OP   +:=     = ( REF HOUSE h, HOUSE s )VOID:
         ( set( nationality OF h, nationality OF s ); set( animal OF h, animal OF s )
         ; set( colour      OF h, colour      OF s ); set( drink  OF h, drink  OF s )
         ; set( smoke       OF h, smoke       OF s )
         ) # +:= # ;
    # sets a field in a house to unknown if the value is not same               #
    PROC reset   = ( REF INT field, INT value )VOID: IF value /= same THEN field := unknown FI;
    # sets fields in house h to unknown if the suggestion s is not same         #
    OP   -:=     = ( REF HOUSE h, HOUSE s )VOID:
         ( reset( nationality OF h, nationality OF s ); reset( animal OF h, animal OF s )
         ; reset( colour      OF h, colour      OF s ); reset( drink  OF h, drink  OF s )
         ; reset( smoke       OF h, smoke       OF s )
         ) # -:= # ;
    # attempts a partial solution for the house at pos                          #
    PROC try = ( INT pos, HOUSE suggestion, PROC VOID continue )VOID:
         IF pos >= LWB house AND pos <= UPB house THEN
             IF house[ pos ] XOR suggestion THEN
                house[ pos ] +:= suggestion; continue; house[ pos ] -:= suggestion
             FI
         FI # try # ;
    # attempts a partial solution for the neighbours of a house                 #
    PROC left or right = ( INT pos, BOOL left, BOOL right, HOUSE neighbour suggestion
                         , PROC VOID continue )VOID:
         ( IF left  THEN try( pos - 1, neighbour suggestion, continue ) FI
         ; IF right THEN try( pos + 1, neighbour suggestion, continue ) FI
         ) # left or right # ;
    # attempts a partial solution for all houses and possibly their neighbours  #
    PROC any2 = ( REF INT number, HOUSE suggestion
                , BOOL left, BOOL right, HOUSE neighbour suggestion
                , PROC VOID continue )VOID:
         FOR pos TO UPB house DO
             IF house[ pos ] XOR suggestion THEN
                 number    := pos;
                 house[ number ] +:= suggestion;
                 IF NOT left AND NOT right THEN # neighbours not involved       #
                     continue
                 ELSE                           # try one or both neighbours    #
                     left or right( pos, left, right, neighbour suggestion, continue )
                 FI;
                 house[ number ] -:= suggestion
             FI
         OD # any2 # ;
    # attempts a partial solution for all houses                                #
    PROC any = ( HOUSE suggestion, PROC VOID continue )VOID:
         any2( LOC INT, suggestion, FALSE, FALSE, SKIP, continue );
    # find solution(s)                                                          #
    INT blend pos;
    INT solutions := 0;
    # There are five houses.                                                    #
    [ 1 : 5 ]HOUSE house;
    FOR h TO UPB house DO house[ h ] := ( unknown, unknown, unknown, unknown, unknown ) OD;
    # In the middle house they drink milk.                                      #
    drink       OF house[ 3 ] := milk;
    # The Norwegian lives in the first house.                                   #
    nationality OF house[ 1 ] := norwegian;
    # The Norwegian lives next to the blue house.                               #
    colour      OF house[ 2 ] := blue;
    # They drink coffee in the green house.                                     #
    # The green house is immediately to the left of the white house.            #
    any2( LOC INT,     ( same, same, green, coffee, same )
       ,  FALSE, TRUE, ( same, same, white, same,   same ), VOID:
      # In a house next to the house where they have a horse,                   #
      # they smoke Dunhill.                                                     #
      # In the yellow house they smoke Dunhill.                                 #
      any2( LOC INT,    ( same, horse, same,   same, same    )
          , TRUE, TRUE, ( same, same,  yellow, same, dunhill ), VOID:
        # The English man lives in the red house.                               #
        any( ( english, same, red, same, same ), VOID:
          # The man who smokes Blend lives in the house next to the             #
          # house with cats.                                                    #
          any2( blend pos,  ( same, same, same, same, blend )
              , TRUE, TRUE, ( same, cats, same, same, same  ), VOID:
            # They drink water in a house next to the house where               #
            # they smoke Blend.                                                 #
            left or right( blend pos, TRUE, TRUE, ( same, same, same, water, same ), VOID:
              # The Dane drinks tea.                                            #
              any( ( dane, same, same, tea, same ), VOID:
                # The man who smokes Blue Master drinks beer.                   #
                any( ( same, same, same, beer, blue master ), VOID:
                  # The Swede has a dog.                                        #
                  any( ( swede, dog, same, same, same ), VOID:
                    # The German smokes Prince.                                 #
                    any( ( german, same, same, same, prince ), VOID:
                      # The man who smokes Pall Mall has birds.                 #
                      any( ( same, birds, same, same, pall mall ), VOID:
                        # if we can place the zebra, we have a solution         #
                        any( ( same, zebra, same, same, same ), VOID:
                             ( solutions +:= 1;
                               FOR h TO UPB house DO
                                 print( ( whole( h, 0 )
                                        , " ",  nationality[ 1 + nationality OF house[ h ] ]
                                        , ", ", animal     [ 1 + animal      OF house[ h ] ]
                                        , ", ", colour     [ 1 + colour      OF house[ h ] ]
                                        , ", ", drink      [ 1 + drink       OF house[ h ] ]
                                        , ", ", smoke      [ 1 + smoke       OF house[ h ] ]
                                        , newline
                                        )
                                      )
                               OD;
                               print( ( newline ) )
                             )
                           ) # zebra     #
                         ) # pall mall  #
                       ) # german      #
                     ) # swede        #
                   ) # beer          #
                 ) # dane           #
               ) # blend L/R       #
             ) # blend            #
           ) # red               #
         ) # horse              #
       ) # green               # ;
    print( ( "solutions: ", whole( solutions, 0 ), newline ) )
END


function worldcupstages()
    games = ["12", "13", "14", "23", "24", "34"]
    results = "000000"

    function nextresult()
        if (results == "222222")
            return false
        end
        results = lpad(string(parse(Int, results, base=3) + 1, base=3), 6, '0')
        true
    end

    points = zeros(Int, 4, 10)
    while true
        records = zeros(Int, 4)
        for i in 1:length(games)
            if results[i] == '2'
                records[games[i][1] - '0'] += 3
            elseif results[i] == '1'
                records[games[i][1] - '0'] += 1
                records[games[i][2] - '0'] += 1
            elseif results[i] == '0'
                records[games[i][2] - '0'] += 3
            end
        end
        sort!(records)
        for i in 1:4
            points[i, records[i] + 1] += 1
        end
        if !nextresult()
            break
        end
    end

    for (i, place) in enumerate(["First", "Second", "Third", "Fourth"])
        println("$place place: $(points[5 - i, :])")
    end
end

worldcupstages()


// version 1.1.2

val games = arrayOf("12", "13", "14", "23", "24", "34")
var results = "000000"

fun nextResult(): Boolean {
    if (results == "222222") return false
    val res = results.toInt(3) + 1
    results = res.toString(3).padStart(6, '0')
    return true
}

fun main(args: Array<String>) {
    val points = Array(4) { IntArray(10) }
    do {
        val records = IntArray(4)
        for (i in 0..5) {
            when (results[i]) {
                '2' -> records[games[i][0] - '1'] += 3
                '1' -> { records[games[i][0] - '1']++ ; records[games[i][1] - '1']++ }
                '0' -> records[games[i][1] - '1'] += 3
            }
        }
        records.sort()
        for (i in 0..3) points[i][records[i]]++
    }
    while(nextResult())
    println("POINTS       0    1    2    3    4    5    6    7    8    9")
    println("-------------------------------------------------------------")
    val places = arrayOf("1st", "2nd", "3rd", "4th")
    for (i in 0..3) {
        print("${places[i]} place    ")
        points[3 - i].forEach { print("%-5d".format(it)) }
        println()
    }
}


x := #( 1 2 3 1e11 ).
y := x collect:#sqrt.
xprecision := 3.
yprecision := 5.

'sqrt.dat' asFilename writingFileDo:[:fileStream |
    x with:y do:[:xI :yI |
        '%.*g\t%.*g\n' printf:{ xprecision . xI . yprecision . yI } on:fileStream
    ]
]


fun writeDat (filename, x, y, xprec, yprec) = let
  val os = TextIO.openOut filename
  fun write_line (a, b) =
    TextIO.output (os, Real.fmt (StringCvt.GEN (SOME xprec)) a ^ "\t" ^
                       Real.fmt (StringCvt.GEN (SOME yprec)) b ^ "\n")
in
  ListPair.appEq write_line (x, y);
  TextIO.closeOut os
end;


* Create the dataset
clear
mat x=1\2\3\1e11
svmat double x
ren *1 *
gen y=sqrt(x)
format %10.1g x
format %10.5g y

* Save as text file
export delim file.txt, delim(" ") novar datafmt replace


set x {1 2 3 1e11}
foreach a $x {lappend y [expr {sqrt($a)}]}
set fh [open sqrt.dat w]
foreach a $x b $y {
    puts $fh [format "%.*g\t%.*g" $xprecision $a $yprecision $b]
}
close $fh

set fh [open sqrt.dat]
puts [read $fh [file size sqrt.dat]]
close $fh


      REM The names (only used for printing the results):
      DIM Drink$(4), Nation$(4), Colr$(4), Smoke$(4), Animal$(4)
      Drink$()  = "Beer", "Coffee", "Milk", "Tea", "Water"
      Nation$() = "Denmark", "England", "Germany", "Norway", "Sweden"
      Colr$()   = "Blue", "Green", "Red", "White", "Yellow"
      Smoke$()  = "Blend", "BlueMaster", "Dunhill", "PallMall", "Prince"
      Animal$() = "Birds", "Cats", "Dog", "Horse", "Zebra"

      REM Some single-character tags:
      a$ = "A" : b$ = "B" : c$ = "C" : d$ = "D" : e$ = "E"

      REM BBC BASIC Doesn't have enumerations!
      Beer$=a$    : Coffee$=b$     : Milk$=c$    : Tea$=d$      : Water$=e$
      Denmark$=a$ : England$=b$    : Germany$=c$ : Norway$=d$   : Sweden$=e$
      Blue$=a$    : Green$=b$      : Red$=c$     : White$=d$    : Yellow$=e$
      Blend$=a$   : BlueMaster$=b$ : Dunhill$=c$ : PallMall$=d$ : Prince$=e$
      Birds$=a$   : Cats$=b$       : Dog$=c$     : Horse$=d$    : Zebra$=e$

      REM Create the 120 permutations of 5 objects:
      DIM perm$(120), x$(4) : x$() = a$, b$, c$, d$, e$
      REPEAT
        p% += 1
        perm$(p%) = x$(0)+x$(1)+x$(2)+x$(3)+x$(4)
      UNTIL NOT FNperm(x$())

      REM Express the statements as conditional expressions:
      ex2$ = "INSTR(Nation$,England$) = INSTR(Colr$,Red$)"
      ex3$ = "INSTR(Nation$,Sweden$) = INSTR(Animal$,Dog$)"
      ex4$ = "INSTR(Nation$,Denmark$) = INSTR(Drink$,Tea$)"
      ex5$ = "INSTR(Colr$,Green$+White$) <> 0"
      ex6$ = "INSTR(Drink$,Coffee$) = INSTR(Colr$,Green$)"
      ex7$ = "INSTR(Smoke$,PallMall$) = INSTR(Animal$,Birds$)"
      ex8$ = "INSTR(Smoke$,Dunhill$) = INSTR(Colr$,Yellow$)"
      ex9$ = "MID$(Drink$,3,1) = Milk$"
      ex10$ = "LEFT$(Nation$,1) = Norway$"
      ex11$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Animal$,Cats$)) = 1"
      ex12$ = "ABS(INSTR(Smoke$,Dunhill$)-INSTR(Animal$,Horse$)) = 1"
      ex13$ = "INSTR(Smoke$,BlueMaster$) = INSTR(Drink$,Beer$)"
      ex14$ = "INSTR(Nation$,Germany$) = INSTR(Smoke$,Prince$)"
      ex15$ = "ABS(INSTR(Nation$,Norway$)-INSTR(Colr$,Blue$)) = 1"
      ex16$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Drink$,Water$)) = 1"

      REM Solve:
      solutions% = 0
      TIME = 0
      FOR nation% = 1 TO 120
        Nation$ = perm$(nation%)
        IF EVAL(ex10$) THEN
          FOR colr% = 1 TO 120
            Colr$ = perm$(colr%)
            IF EVAL(ex5$) IF EVAL(ex2$) IF EVAL(ex15$) THEN
              FOR drink% = 1 TO 120
                Drink$ = perm$(drink%)
                IF EVAL(ex9$) IF EVAL(ex4$) IF EVAL(ex6$) THEN
                  FOR smoke% = 1 TO 120
                    Smoke$ = perm$(smoke%)
                    IF EVAL(ex14$) IF EVAL(ex13$) IF EVAL(ex16$) IF EVAL(ex8$) THEN
                      FOR animal% = 1 TO 120
                        Animal$ = perm$(animal%)
                        IF EVAL(ex3$) IF EVAL(ex7$) IF EVAL(ex11$) IF EVAL(ex12$) THEN
                          PRINT "House     Drink     Nation    Colour    Smoke     Animal"
                          FOR house% = 1 TO 5
                            PRINT ; house% ,;
                            PRINT Drink$(ASCMID$(Drink$,house%)-65),;
                            PRINT Nation$(ASCMID$(Nation$,house%)-65),;
                            PRINT Colr$(ASCMID$(Colr$,house%)-65),;
                            PRINT Smoke$(ASCMID$(Smoke$,house%)-65),;
                            PRINT Animal$(ASCMID$(Animal$,house%)-65)
                          NEXT
                          solutions% += 1
                        ENDIF
                      NEXT animal%
                    ENDIF
                  NEXT smoke%
                ENDIF
              NEXT drink%
            ENDIF
          NEXT colr%
        ENDIF
      NEXT nation%
      PRINT '"Number of solutions = "; solutions%
      PRINT "Solved in " ; TIME/100 " seconds"
      END

      DEF FNperm(x$())
      LOCAL i%, j%
      FOR i% = DIM(x$(),1)-1 TO 0 STEP -1
        IF x$(i%) < x$(i%+1) EXIT FOR
      NEXT
      IF i% < 0 THEN = FALSE
      j% = DIM(x$(),1)
      WHILE x$(j%) <= x$(i%) j% -= 1 : ENDWHILE
      SWAP x$(i%), x$(j%)
      i% += 1
      j% = DIM(x$(),1)
      WHILE i% < j%
        SWAP x$(i%), x$(j%)
        i% += 1
        j% -= 1
      ENDWHILE
      = TRUE


function array1D(a, d)
    local m = {}
    for i=1,a do
        table.insert(m, d)
    end
    return m
end

function array2D(a, b, d)
    local m = {}
    for i=1,a do
        table.insert(m, array1D(b, d))
    end
    return m
end

function fromBase3(num)
    local out = 0
    for i=1,#num do
        local c = num:sub(i,i)
        local d = tonumber(c)
        out = 3 * out + d
    end
    return out
end

function toBase3(num)
    local ss = ""
    while num > 0 do
        local rem = num % 3
        num = math.floor(num / 3)
        ss = ss .. tostring(rem)
    end
    return string.reverse(ss)
end

games = { "12", "13", "14", "23", "24", "34" }

results = "000000"
function nextResult()
    if results == "222222" then
        return false
    end

    local res = fromBase3(results)
    results = string.format("%06s", toBase3(res + 1))

    return true
end

points = array2D(4, 10, 0)

repeat
    local records = array1D(4, 0)

    for i=1,#games do
        if results:sub(i,i) == '2' then
            local j = tonumber(games[i]:sub(1,1))
            records[j] = records[j] + 3
        elseif results:sub(i,i) == '1' then
            local j = tonumber(games[i]:sub(1,1))
            records[j] = records[j] + 1
            j = tonumber(games[i]:sub(2,2))
            records[j] = records[j] + 1
        elseif results:sub(i,i) == '0' then
            local j = tonumber(games[i]:sub(2,2))
            records[j] = records[j] + 3
        end
    end

    table.sort(records)
    for i=1,#records do
        points[i][records[i]+1] = points[i][records[i]+1] + 1
    end
until not nextResult()

print("POINTS       0    1    2    3    4    5    6    7    8    9")
print("-------------------------------------------------------------")
places = { "1st", "2nd", "3rd", "4th" }
for i=1,#places do
    io.write(places[i] .. " place")
    local row = points[i]
    for j=1,#row do
        io.write(string.format("%5d", points[5 - i][j]))
    end
    print()
end


Public Sub main()
    x = [{1, 2, 3, 1e11}]
    y = [{1, 1.4142135623730951, 1.7320508075688772, 316227.76601683791}]
    Dim TextFile As Integer
    TextFile = FreeFile
    Open "filename" For Output As TextFile
    For i = 1 To UBound(x)
        Print #TextFile, Format(x(i), "0.000E-000"), Format(y(i), "0.00000E-000")
    Next i
    Close TextFile
End Sub


import os
const (
    x = [1.0, 2, 3, 1e11]
    y = [1.0, 1.4142135623730951, 1.7320508075688772, 316227.76601683791]

    xprecision = 3
    yprecision = 5
)

fn main() {
    if x.len != y.len {
        println("x, y different length")
        return
    }
    mut f := os.create("filename")?
    defer {
        f.close()
    }
    for i,_ in x {
        f.write_string('${x[i]:3}, ${y[i]:1G}\n')?
    }
}


x$ = "1 2 3 1e11"
pr1 = 3 : pr2 = 5

dim x$(1)
n = token(x$, x$())

f = open("filename.txt", "w")

for i = 1 to n
	print #f str$(val(x$(i)), "%1." + str$(pr1) + "g") + "\t" + str$(sqrt(val(x$(i))), "%1." + str$(pr2) + "g")
next i

close #f


(     (English Swede Dane Norwegian German,)
      (red green white yellow blue,(red.English.))
      (dog birds cats horse zebra,(dog.?.Swede.))
      ( tea coffee milk beer water
      , (tea.?.?.Dane.) (coffee.?.green.?.)
      )
      ( "Pall Mall" Dunhill Blend "Blue Master" Prince
      ,   ("Blue Master".beer.?.?.?.)
          ("Pall Mall".?.birds.?.?.)
          (Dunhill.?.?.yellow.?.)
          (Prince.?.?.?.German.)
      )
      ( 1 2 3 4 5
      , (3.?.milk.?.?.?.) (1.?.?.?.?.Norwegian.)
      )
  : ?properties
& ( relations
  =   next leftOf
    .   ( next
        =   a b A B
          .   !arg:(?S,?A,?B)
            & !S:? (?a.!A) ?:? (?b.!B) ?
            & (!a+1:!b|!b+1:!a)
        )
      & ( leftOf
        =   a b A B
          .   !arg:(?S,?A,?B)
            & !S:? (?a.!A) ?:? (?b.!B) ?
            & !a+1:!b
        )
      &   leftOf
        $ (!arg,(?.?.?.green.?.),(?.?.?.white.?.))
      & next$(!arg,(Blend.?.?.?.?.),(?.?.cats.?.?.))
      &   next
        $ (!arg,(?.?.horse.?.?.),(Dunhill.?.?.?.?.))
      &   next
        $ (!arg,(?.?.?.?.Norwegian.),(?.?.?.blue.?.))
      & next$(!arg,(?.water.?.?.?.),(Blend.?.?.?.?.))
  )
& ( props
  =     a constraint constraints house houses
      , remainingToDo shavedToDo toDo value values z
    .   !arg:(?toDo.?shavedToDo.?house.?houses)
      & (   !toDo:(?values,?constraints) ?remainingToDo
          &   !values
            : (   ?a
                  ( %@?value
                  &   !constraints
                    : (   ?
                          ( !value
                          .   ?constraint
                            & !house:!constraint
                          )
                          ?
                      | ~(   ?
                             ( ?
                             .   ?constraint
                               & !house:!constraint
                             )
                             ?
                         | ? (!value.?) ?
                         )
                      )
                  )
                  ( ?z
                  &   props
                    $ ( !remainingToDo
                      . !shavedToDo (!a !z,!constraints)
                      . (!value.!house)
                      . !houses
                      )
                  )
              |
                & relations$!houses
                & out$(Solution !houses)
              )
        |   !toDo:
          & props$(!shavedToDo...!house !houses)
        )
  )
& props$(!properties...)
& done
);


#include <stdio.h>
#include <string.h>

enum HouseStatus { Invalid, Underfull, Valid };

enum Attrib { C, M, D, A, S };

// Unfilled attributes are represented by -1
enum Colors { Red, Green, White, Yellow, Blue };
enum Mans { English, Swede, Dane, German, Norwegian };
enum Drinks { Tea, Coffee, Milk, Beer, Water };
enum Animals { Dog, Birds, Cats, Horse, Zebra };
enum Smokes { PallMall, Dunhill, Blend, BlueMaster, Prince };

void printHouses(int ha[5][5]) {
    const char *color[] =  { "Red", "Green", "White", "Yellow", "Blue" };
    const char *man[] =    { "English", "Swede", "Dane", "German", "Norwegian" };
    const char *drink[] =  { "Tea", "Coffee", "Milk", "Beer", "Water" };
    const char *animal[] = { "Dog", "Birds", "Cats", "Horse", "Zebra" };
    const char *smoke[] =  { "PallMall", "Dunhill", "Blend", "BlueMaster", "Prince" };

    printf("%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s\n",
           "House", "Color", "Man", "Drink", "Animal", "Smoke");

    for (int i = 0; i < 5; i++) {
        printf("%-10d", i);
        if (ha[i][C] >= 0)
            printf("%-10.10s", color[ha[i][C]]);
        else
            printf("%-10.10s", "-");
        if (ha[i][M] >= 0)
            printf("%-10.10s", man[ha[i][M]]);
        else
            printf("%-10.10s", "-");
        if (ha[i][D] >= 0)
            printf("%-10.10s", drink[ha[i][D]]);
        else
            printf("%-10.10s", "-");
        if (ha[i][A] >= 0)
            printf("%-10.10s", animal[ha[i][A]]);
        else
            printf("%-10.10s", "-");
        if (ha[i][S] >= 0)
            printf("%-10.10s\n", smoke[ha[i][S]]);
        else
            printf("-\n");
    }
}

int checkHouses(int ha[5][5]) {
    int c_add = 0, c_or = 0;
    int m_add = 0, m_or = 0;
    int d_add = 0, d_or = 0;
    int a_add = 0, a_or = 0;
    int s_add = 0, s_or = 0;

    // Cond 9: In the middle house they drink milk.
    if (ha[2][D] >= 0 && ha[2][D] != Milk)
        return Invalid;

    // Cond 10: The Norwegian lives in the first house.
    if (ha[0][M] >= 0 && ha[0][M] != Norwegian)
        return Invalid;

    for (int i = 0; i < 5; i++) {
        // Uniqueness tests.
        if (ha[i][C] >= 0) {
            c_add += (1 << ha[i][C]);
            c_or |= (1 << ha[i][C]);
        }
        if (ha[i][M] >= 0) {
            m_add += (1 << ha[i][M]);
            m_or |= (1 << ha[i][M]);
        }
        if (ha[i][D] >= 0) {
            d_add += (1 << ha[i][D]);
            d_or |= (1 << ha[i][D]);
        }
        if (ha[i][A] >= 0) {
            a_add += (1 << ha[i][A]);
            a_or |= (1 << ha[i][A]);
        }
        if (ha[i][S] >= 0) {
            s_add += (1 << ha[i][S]);
            s_or |= (1 << ha[i][S]);
        }

        // Cond 2: The English man lives in the red house.
        if ((ha[i][M] >= 0 && ha[i][C] >= 0) &&
            ((ha[i][M] == English && ha[i][C] != Red) || // Checking both
             (ha[i][M] != English && ha[i][C] == Red)))  // to make things quicker.
            return Invalid;

        // Cond 3: The Swede has a dog.
        if ((ha[i][M] >= 0 && ha[i][A] >= 0) &&
            ((ha[i][M] == Swede && ha[i][A] != Dog) ||
             (ha[i][M] != Swede && ha[i][A] == Dog)))
            return Invalid;

        // Cond 4: The Dane drinks tea.
        if ((ha[i][M] >= 0 && ha[i][D] >= 0) &&
            ((ha[i][M] == Dane && ha[i][D] != Tea) ||
             (ha[i][M] != Dane && ha[i][D] == Tea)))
            return Invalid;

        // Cond 5: The green house is immediately to the left of the white house.
        if ((i > 0 && ha[i][C] >= 0 /*&& ha[i-1][C] >= 0 */ ) &&
            ((ha[i - 1][C] == Green && ha[i][C] != White) ||
             (ha[i - 1][C] != Green && ha[i][C] == White)))
            return Invalid;

        // Cond 6: drink coffee in the green house.
        if ((ha[i][C] >= 0 && ha[i][D] >= 0) &&
            ((ha[i][C] == Green && ha[i][D] != Coffee) ||
             (ha[i][C] != Green && ha[i][D] == Coffee)))
            return Invalid;

        // Cond 7: The man who smokes Pall Mall has birds.
        if ((ha[i][S] >= 0 && ha[i][A] >= 0) &&
            ((ha[i][S] == PallMall && ha[i][A] != Birds) ||
             (ha[i][S] != PallMall && ha[i][A] == Birds)))
            return Invalid;

        // Cond 8: In the yellow house they smoke Dunhill.
        if ((ha[i][S] >= 0 && ha[i][C] >= 0) &&
            ((ha[i][S] == Dunhill && ha[i][C] != Yellow) ||
             (ha[i][S] != Dunhill && ha[i][C] == Yellow)))
            return Invalid;

        // Cond 11: The man who smokes Blend lives in the house next to the house with cats.
        if (ha[i][S] == Blend) {
            if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats)
                return Invalid;
            else if (i == 4 && ha[i - 1][A] != Cats)
                return Invalid;
            else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats && ha[i - 1][A] != Cats)
                return Invalid;
        }

        // Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
        if (ha[i][S] == Dunhill) {
            if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse)
                return Invalid;
            else if (i == 4 && ha[i - 1][A] != Horse)
                return Invalid;
            else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse && ha[i - 1][A] != Horse)
                return Invalid;
        }

        // Cond 13: The man who smokes Blue Master drinks beer.
        if ((ha[i][S] >= 0 && ha[i][D] >= 0) &&
            ((ha[i][S] == BlueMaster && ha[i][D] != Beer) ||
             (ha[i][S] != BlueMaster && ha[i][D] == Beer)))
            return Invalid;

        // Cond 14: The German smokes Prince
        if ((ha[i][M] >= 0 && ha[i][S] >= 0) &&
            ((ha[i][M] == German && ha[i][S] != Prince) ||
             (ha[i][M] != German && ha[i][S] == Prince)))
            return Invalid;

        // Cond 15: The Norwegian lives next to the blue house.
        if (ha[i][M] == Norwegian &&
            ((i < 4 && ha[i + 1][C] >= 0 && ha[i + 1][C] != Blue) ||
             (i > 0 && ha[i - 1][C] != Blue)))
            return Invalid;

        // Cond 16: They drink water in a house next to the house where they smoke Blend.
        if (ha[i][S] == Blend) {
            if (i == 0 && ha[i + 1][D] >= 0 && ha[i + 1][D] != Water)
                return Invalid;
            else if (i == 4 && ha[i - 1][D] != Water)
                return Invalid;
            else if (ha[i + 1][D] >= 0 && ha[i + 1][D] != Water && ha[i - 1][D] != Water)
                return Invalid;
        }

    }

    if ((c_add != c_or) || (m_add != m_or) || (d_add != d_or)
        || (a_add != a_or) || (s_add != s_or)) {
        return Invalid;
    }

    if ((c_add != 0b11111) || (m_add != 0b11111) || (d_add != 0b11111)
        || (a_add != 0b11111) || (s_add != 0b11111)) {
        return Underfull;
    }

    return Valid;
}

int bruteFill(int ha[5][5], int hno, int attr) {
    int stat = checkHouses(ha);
    if ((stat == Valid) || (stat == Invalid))
        return stat;

    int hb[5][5];
    memcpy(hb, ha, sizeof(int) * 5 * 5);
    for (int i = 0; i < 5; i++) {
        hb[hno][attr] = i;
        stat = checkHouses(hb);
        if (stat != Invalid) {
            int nexthno, nextattr;
            if (attr < 4) {
                nextattr = attr + 1;
                nexthno = hno;
            } else {
                nextattr = 0;
                nexthno = hno + 1;
            }

            stat = bruteFill(hb, nexthno, nextattr);
            if (stat != Invalid) {
                memcpy(ha, hb, sizeof(int) * 5 * 5);
                return stat;
            }
        }
    }

    // We only come here if none of the attr values assigned were valid.
    return Invalid;
}

int main() {
    int ha[5][5] = {{-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
                    {-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
                    {-1, -1, -1, -1, -1}};

    bruteFill(ha, 0, 0);
    printHouses(ha);

    return 0;
}


import algorithm, sequtils, strutils
import itertools

const Scoring = [0, 1, 3]

var histo: array[4, array[10, int]]

for results in product([0, 1, 2], repeat = 6):
  var s: array[4, int]
  for (r, g) in zip(results, toSeq(combinations([0, 1, 2, 3], 2))):
    s[g[0]] += Scoring[r]
    s[g[1]] += Scoring[2 - r]
  for i, v in sorted(s):
    inc histo[i][v]

for x in reversed(histo):
  echo x.mapIt(($it).align(3)).join(" ")


fcn writeFloatArraysToFile(filename, xs,xprecision, ys,yprecision){
   f  :=File(filename,"w");
   fmt:="%%.%dg\t%%.%dg".fmt(xprecision,yprecision).fmt;  // "%.3g\t%.5g".fmt
   foreach x,y in (xs.zip(ys)){ f.writeln(fmt(x,y)); }
   f.close();
}

xs,ys := T(1.0, 2.0, 3.0, 1e11), xs.apply("sqrt");
xprecision,yprecision := 3,5;
writeFloatArraysToFile("floatArray.txt", xs,xprecision, ys,yprecision);


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using static System.Console;

public enum Colour { Red, Green, White, Yellow, Blue }
public enum Nationality { Englishman, Swede, Dane, Norwegian,German }
public enum Pet { Dog, Birds, Cats, Horse, Zebra }
public enum Drink { Coffee, Tea, Milk, Beer, Water }
public enum Smoke { PallMall, Dunhill, Blend, BlueMaster, Prince}

public static class ZebraPuzzle
{
    private static (Colour[] colours, Drink[] drinks, Smoke[] smokes, Pet[] pets, Nationality[] nations) _solved;

    static ZebraPuzzle()
    {
        var solve = from colours in Permute<Colour>()  //r1 5 range
                    where (colours,Colour.White).IsRightOf(colours, Colour.Green) // r5
                    from nations in Permute<Nationality>()
                    where nations[0] == Nationality.Norwegian // r10
                    where (nations, Nationality.Englishman).IsSameIndex(colours, Colour.Red) //r2
                    where (nations,Nationality.Norwegian).IsNextTo(colours,Colour.Blue) // r15
                    from drinks in Permute<Drink>()
                    where drinks[2] == Drink.Milk //r9
                    where (drinks, Drink.Coffee).IsSameIndex(colours, Colour.Green) // r6
                    where (drinks, Drink.Tea).IsSameIndex(nations, Nationality.Dane) //r4
                    from pets in Permute<Pet>()
                    where (pets, Pet.Dog).IsSameIndex(nations, Nationality.Swede) // r3
                    from smokes in Permute<Smoke>()
                    where (smokes, Smoke.PallMall).IsSameIndex(pets, Pet.Birds) // r7
                    where (smokes, Smoke.Dunhill).IsSameIndex(colours, Colour.Yellow) // r8
                    where (smokes, Smoke.Blend).IsNextTo(pets, Pet.Cats) // r11
                    where (smokes, Smoke.Dunhill).IsNextTo(pets, Pet.Horse) //r12
                    where (smokes, Smoke.BlueMaster).IsSameIndex(drinks, Drink.Beer) //r13
                    where (smokes, Smoke.Prince).IsSameIndex(nations, Nationality.German) // r14
                    where (drinks,Drink.Water).IsNextTo(smokes,Smoke.Blend) // r16
                    select (colours, drinks, smokes, pets, nations);

        _solved = solve.First();
    }

    private static int IndexOf<T>(this T[] arr, T obj) => Array.IndexOf(arr, obj);

    private static bool IsRightOf<T, U>(this (T[] a, T v) right, U[] a, U v) => right.a.IndexOf(right.v) == a.IndexOf(v) + 1;

    private static bool IsSameIndex<T, U>(this (T[] a, T v)x, U[] a, U v) => x.a.IndexOf(x.v) == a.IndexOf(v);

    private static bool IsNextTo<T, U>(this (T[] a, T v)x, U[] a,  U v) => (x.a,x.v).IsRightOf(a, v) || (a,v).IsRightOf(x.a,x.v);

    // made more generic from https://codereview.stackexchange.com/questions/91808/permutations-in-c
    public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values)
    {
        if (values.Count() == 1)
            return values.ToSingleton();

        return values.SelectMany(v => Permutations(values.Except(v.ToSingleton())),(v, p) => p.Prepend(v));
    }

    public static IEnumerable<T[]> Permute<T>() => ToEnumerable<T>().Permutations().Select(p=>p.ToArray());

    private static IEnumerable<T> ToSingleton<T>(this T item){ yield return item; }

    private static IEnumerable<T> ToEnumerable<T>() => Enum.GetValues(typeof(T)).Cast<T>();

    public static new String ToString()
    {
        var sb = new StringBuilder();
        sb.AppendLine("House Colour Drink    Nationality Smokes     Pet");
        sb.AppendLine("───── ────── ──────── ─────────── ────────── ─────");
        var (colours, drinks, smokes, pets, nations) = _solved;
        for (var i = 0; i < 5; i++)
            sb.AppendLine($"{i+1,5} {colours[i],-6} {drinks[i],-8} {nations[i],-11} {smokes[i],-10} {pets[i],-10}");
        return sb.ToString();
    }

    public static void Main(string[] arguments)
    {
        var owner = _solved.nations[_solved.pets.IndexOf(Pet.Zebra)];
        WriteLine($"The zebra owner is {owner}");
        Write(ToString());
        Read();
    }
}


function game_combinations(sequence res, integer pool, needed, sequence chosen={})
    if needed=0 then
        res = append(res,chosen) -- collect the full sets
    else
        for i=iff(length(chosen)=0?1:chosen[$]+1) to pool do
            res = game_combinations(res,pool,needed-1,append(deep_copy(chosen),i))
        end for
    end if
    return res
end function

constant games = game_combinations({},4,2) -- ie {{1,2},{1,3},{1,4},{2,3},{2,4},{3,4}}

constant scores = {{3,0},{1,1},{0,3}}   -- ie win/draw/lose

sequence points = repeat(repeat(0,10),4) -- 1st..4th place, 0..9 points

procedure result_combinations(integer pool, needed, sequence chosen={})
    if needed=0 then
        -- (here, chosen is {1,1,1,1,1,1}..{3,3,3,3,3,3}, 729 in all)
        sequence results = repeat(0,4)
        for i=1 to length(chosen) do
            integer {team1,team2} = games[i]
            integer {points1,points2} = scores[chosen[i]]
            results[team1] += points1
            results[team2] += points2
        end for
        results = sort(results)
        for i=1 to 4 do points[i][results[i]+1] += 1 end for
    else
        for i=1 to pool do
            result_combinations(pool,needed-1,append(deep_copy(chosen),i))
        end for
    end if
end procedure

-- accumulate the results of all possible outcomes (1..3) of 6 games:
result_combinations(3,6)    -- (the result ends up in points)
--result_combinations(length(scores),length(games)) -- (equivalent)

constant fmt = join(repeat("%5d",10))&"\n",
         cardinals = {"st","nd","rd","th"}
printf(1,"   points "&fmt&repeat('-',69)&"\n",tagset(9,0))
for i=1 to 4 do
    printf(1,"%d%s place "&fmt,{i,cardinals[i]}&points[5-i])
end for


#include <stdio.h>
#include <string.h>

#define defenum(name, val0, val1, val2, val3, val4) \
    enum name { val0, val1, val2, val3, val4 }; \
    const char *name ## _str[] = { # val0, # val1, # val2, # val3, # val4 }

defenum( Attrib,    Color, Man, Drink, Animal, Smoke );
defenum( Colors,    Red, Green, White, Yellow, Blue );
defenum( Mans,      English, Swede, Dane, German, Norwegian );
defenum( Drinks,    Tea, Coffee, Milk, Beer, Water );
defenum( Animals,   Dog, Birds, Cats, Horse, Zebra );
defenum( Smokes,    PallMall, Dunhill, Blend, BlueMaster, Prince );

void printHouses(int ha[5][5]) {
    const char **attr_names[5] = {Colors_str, Mans_str, Drinks_str, Animals_str, Smokes_str};

    printf("%-10s", "House");
    for (const char *name : Attrib_str) printf("%-10s", name);
    printf("\n");

    for (int i = 0; i < 5; i++) {
        printf("%-10d", i);
        for (int j = 0; j < 5; j++) printf("%-10s", attr_names[j][ha[i][j]]);
        printf("\n");
    }
}

struct HouseNoRule {
    int houseno;
    Attrib a; int v;
} housenos[] = {
    {2, Drink, Milk},     // Cond 9: In the middle house they drink milk.
    {0, Man, Norwegian}   // Cond 10: The Norwegian lives in the first house.
};

struct AttrPairRule {
    Attrib a1; int v1;
    Attrib a2; int v2;

    bool invalid(int ha[5][5], int i) {
        return (ha[i][a1] >= 0 && ha[i][a2] >= 0) &&
               ((ha[i][a1] == v1 && ha[i][a2] != v2) ||
                (ha[i][a1] != v1 && ha[i][a2] == v2));
    }
} pairs[] = {
    {Man, English,      Color, Red},     // Cond 2: The English man lives in the red house.
    {Man, Swede,        Animal, Dog},    // Cond 3: The Swede has a dog.
    {Man, Dane,         Drink, Tea},     // Cond 4: The Dane drinks tea.
    {Color, Green,      Drink, Coffee},  // Cond 6: drink coffee in the green house.
    {Smoke, PallMall,   Animal, Birds},  // Cond 7: The man who smokes Pall Mall has birds.
    {Smoke, Dunhill,    Color, Yellow},  // Cond 8: In the yellow house they smoke Dunhill.
    {Smoke, BlueMaster, Drink, Beer},    // Cond 13: The man who smokes Blue Master drinks beer.
    {Man, German,       Smoke, Prince}    // Cond 14: The German smokes Prince
};

struct NextToRule {
    Attrib a1; int v1;
    Attrib a2; int v2;

    bool invalid(int ha[5][5], int i) {
        return (ha[i][a1] == v1) &&
               ((i == 0 && ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2) ||
                (i == 4 && ha[i - 1][a2] != v2) ||
                (ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2 && ha[i - 1][a2] != v2));
    }
} nexttos[] = {
    {Smoke, Blend,      Animal, Cats},    // Cond 11: The man who smokes Blend lives in the house next to the house with cats.
    {Smoke, Dunhill,    Animal, Horse},   // Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
    {Man, Norwegian,    Color, Blue},     // Cond 15: The Norwegian lives next to the blue house.
    {Smoke, Blend,      Drink, Water}     // Cond 16: They drink water in a house next to the house where they smoke Blend.
};

struct LeftOfRule {
    Attrib a1; int v1;
    Attrib a2; int v2;

    bool invalid(int ha[5][5]) {
        return (ha[0][a2] == v2) || (ha[4][a1] == v1);
    }

    bool invalid(int ha[5][5], int i) {
        return ((i > 0 && ha[i][a1] >= 0) &&
                ((ha[i - 1][a1] == v1 && ha[i][a2] != v2) ||
                 (ha[i - 1][a1] != v1 && ha[i][a2] == v2)));
    }
} leftofs[] = {
    {Color, Green,  Color, White}     // Cond 5: The green house is immediately to the left of the white house.
};

bool invalid(int ha[5][5]) {
    for (auto &rule : leftofs) if (rule.invalid(ha)) return true;

    for (int i = 0; i < 5; i++) {
#define eval_rules(rules) for (auto &rule : rules) if (rule.invalid(ha, i)) return true;
        eval_rules(pairs);
        eval_rules(nexttos);
        eval_rules(leftofs);
    }
    return false;
}

void search(bool used[5][5], int ha[5][5], const int hno, const int attr) {
    int nexthno, nextattr;
    if (attr < 4) {
        nextattr = attr + 1;
        nexthno = hno;
    } else {
        nextattr = 0;
        nexthno = hno + 1;
    }

    if (ha[hno][attr] != -1) {
        search(used, ha, nexthno, nextattr);
    } else {
        for (int i = 0; i < 5; i++) {
            if (used[attr][i]) continue;
            used[attr][i] = true;
            ha[hno][attr] = i;

            if (!invalid(ha)) {
                if ((hno == 4) && (attr == 4)) {
                    printHouses(ha);
                } else {
                    search(used, ha, nexthno, nextattr);
                }
            }

            used[attr][i] = false;
        }
        ha[hno][attr] = -1;
    }
}

int main() {
    bool used[5][5] = {};
    int ha[5][5]; memset(ha, -1, sizeof(ha));

    for (auto &rule : housenos) {
        ha[rule.houseno][rule.a] = rule.v;
        used[rule.a][rule.v] = true;
    }

    search(used, ha, 0, 0);

    return 0;
}


from itertools import product, combinations, izip

scoring = [0, 1, 3]
histo = [[0] * 10 for _ in xrange(4)]

for results in product(range(3), repeat=6):
    s = [0] * 4
    for r, g in izip(results, combinations(range(4), 2)):
        s[g[0]] += scoring[r]
        s[g[1]] += scoring[2 - r]

    for h, v in izip(histo, sorted(s)):
        h[v] += 1

for x in reversed(histo):
    print x


#lang racket
;; Tim Brown 2014-09-15
(define (sort-standing stndg#)
  (sort (hash->list stndg#) > #:key cdr))

(define (hash-update^2 hsh key key2 updater2 dflt2)
  (hash-update hsh key (λ (hsh2) (hash-update hsh2 key2 updater2 dflt2)) hash))

(define all-standings
  (let ((G '((a b) (a c) (a d) (b c) (b d) (c d)))
        (R '((3 0) (1 1) (0 3))))
    (map
     sort-standing
     (for*/list ((r1 R) (r2 R) (r3 R) (r4 R) (r5 R) (r6 R))
       (foldr (λ (gm rslt h)
                (hash-update
                 (hash-update h (second gm) (λ (n) (+ n (second rslt))) 0)
                 (first gm) (curry + (first rslt)) 0))
              (hash) G (list r1 r2 r3 r4 r5 r6))))))

(define histogram
  (for*/fold ((rv (hash)))
    ((stndng (in-list all-standings)) (psn (in-range 0 4)))
    (hash-update^2 rv (add1 psn) (cdr (list-ref stndng psn)) add1 0)))

;; Generalised histogram printing functions...
(define (show-histogram hstgrm# captions)
  (define (min* a b)
    (if (and a b) (min a b) (or a b)))
  (define-values (position-mn position-mx points-mn points-mx)
    (for*/fold ((mn-psn #f) (mx-psn 0) (mn-pts #f) (mx-pts 0))
      (((psn rw) (in-hash hstgrm#)))
      (define-values (min-pts max-pts)
        (for*/fold ((mn mn-pts) (mx mx-pts)) ((pts (in-hash-keys rw)))
          (values (min* pts mn) (max pts mx))))
      (values (min* mn-psn psn) (max mx-psn psn) min-pts max-pts)))

  (define H
    (let ((lbls-row# (for/hash ((i (in-range points-mn (add1 points-mx)))) (values i i))))
      (hash-set hstgrm# 'thead lbls-row#)))

  (define cap-col-width (for/fold ((m 0)) ((v (in-hash-values captions))) (max m (string-length v))))

  (for ((plc (in-sequences
              (in-value 'thead)
              (in-range position-mn (add1 position-mx)))))
    (define cnts (for/list ((pts (in-range points-mn (add1 points-mx))))
                   (~a #:align 'center #:width 3 (hash-ref (hash-ref H plc) pts 0))))
    (printf "~a ~a~%"
            (~a (hash-ref captions plc (curry format "#~a:")) #:width cap-col-width)
            (string-join cnts "  "))))

(define captions
  (hash 'thead "POINTS:"
        1 "1st Place:"
        2 "2nd Place:"
        3 "Sack the manager:"
        4 "Sack the team!"))

(show-histogram histogram captions)


constant scoring = 0, 1, 3;
my @histo = [0 xx 10] xx 4;

for [X] ^3 xx 6 -> @results {
    my @s;

    for @results Z (^4).combinations(2) -> ($r, @g) {
        @s[@g[0]] += scoring[$r];
        @s[@g[1]] += scoring[2 - $r];
    }

    for @histo Z @s.sort -> (@h, $v) {
        ++@h[$v];
    }
}

say .fmt('%3d',' ') for @histo.reverse;


(ns zebra.core
  (:refer-clojure :exclude [==])
  (:use [clojure.core.logic]
        [clojure.tools.macro :as macro]))

(defne lefto [x y l]
       ([_ _ [x y . ?r]])
       ([_ _ [_ . ?r]] (lefto x y ?r)))

(defn nexto [x y l]
  (conde
    ((lefto x y l))
    ((lefto y x l))))

(defn zebrao [hs]
  (macro/symbol-macrolet [_ (lvar)]
    (all
      (== [_ _ _ _ _] hs)
      (membero ['englishman _ _ _ 'red] hs)
      (membero ['swede _ _ 'dog _] hs)
      (membero ['dane _ 'tea _ _] hs)
      (lefto [_ _ _ _ 'green] [_ _ _ _ 'white] hs)
      (membero [_ _ 'coffee _ 'green] hs)
      (membero [_ 'pallmall _ 'birds _] hs)
      (membero [_ 'dunhill _ _ 'yellow] hs)
      (== [_ _ [_ _ 'milk _ _] _ _ ] hs)
      (firsto hs ['norwegian _ _ _ _])
      (nexto [_ 'blend _ _ _] [_ _ _ 'cats _ ] hs)
      (nexto [_ _ _ 'horse _] [_ 'dunhill _ _ _] hs)
      (membero [_ 'bluemaster 'beer _ _] hs)
      (membero ['german 'prince _ _ _] hs)
      (nexto ['norwegian _ _ _ _] [_ _ _ _ 'blue] hs)
      (nexto [_ _ 'water _ _] [_ 'blend _ _ _] hs)
      (membero [_ _ _ 'zebra _] hs))))

(let [solns (run* [q] (zebrao q))
      soln (first solns)
      zebra-owner (->> soln (filter #(= 'zebra (% 3))) first (#(% 0)))]
  (println "solution count:" (count solns))
  (println "zebra owner is the" zebra-owner)
  (println "full solution (in house order):")
  (doseq [h soln] (println " " h)))


/* REXX -------------------------------------------------------------------*/
results = '000000'                      /*start with left teams all losing */
games = '12 13 14 23 24 34'
points.=0
records.=0
Do Until nextResult(results)=0
  records.=0
  Do i=1 To 6
    r=substr(results,i,1)
    g=word(games,i); Parse Var g g1 +1 g2
    Select
      When r='2' Then                   /* win for left team               */
        records.g1=records.g1+3
      When r='1' Then Do                /* draw                            */
        records.g1=records.g1+1
        records.g2=records.g2+1
        End
      When r='0' Then                   /* win for right team              */
        records.g2=records.g2+3
      End
    End
  Call sort_records                     /* sort ascending,                 */
                                        /* first place team on the right   */
  r1=records.1
  r2=records.2
  r3=records.3
  r4=records.4
  points.0.r1=points.0.r1+1
  points.1.r2=points.1.r2+1
  points.2.r3=points.2.r3+1
  points.3.r4=points.3.r4+1
  End
ol.='['
sep=', '
Do i=0 To 9
  If i=9 Then sep=']'
  ol.0=ol.0||points.0.i||sep
  ol.1=ol.1||points.1.i||sep
  ol.2=ol.2||points.2.i||sep
  ol.3=ol.3||points.3.i||sep
  End
Say ol.3
Say ol.2
Say ol.1
Say ol.0
Exit

nextResult: Procedure Expose results
/* results is a string of 6 base 3 digits to which we add 1                */
/* e.g., '000212 +1 -> 000220                                              */
If results="222222" Then Return 0
res=0
do i=1 To 6
  res=res*3+substr(results,i,1)
  End
res=res+1
s=''
Do i=1 To 6
  b=res//3
  res=res%3
  s=b||s
  End
results=s
Return 1

sort_records: Procedure Expose records.
Do i=1 To 3
  Do j=i+1 To 4
    If records.j<records.i Then
      Parse Value records.i records.j With records.j records.i
    End
  End
Return


teams = [:a, :b, :c, :d]
matches = teams.combination(2).to_a
outcomes = [:win, :draw, :loss]
gains = {win:[3,0], draw:[1,1], loss:[0,3]}
places_histogram = Array.new(4) {Array.new(10,0)}

# The Array#repeated_permutation method generates the 3^6 different
# possible outcomes
outcomes.repeated_permutation(6).each do |outcome|
  results = Hash.new(0)

  # combine this outcomes with the matches, and generate the points table
  outcome.zip(matches).each do |decision, (team1, team2)|
    results[team1] += gains[decision][0]
    results[team2] += gains[decision][1]
  end

  # accumulate the results
  results.values.sort.reverse.each_with_index do |points, place|
    places_histogram[place][points] += 1
  end
end

fmt = "%s :" + "%4s"*10
puts fmt % [" ", *0..9]
puts fmt % ["-", *["---"]*10]
places_histogram.each.with_index(1) {|hist,place| puts fmt % [place, *hist]}


CONTENT = {House:       [""],
           Nationality: %i[English Swedish Danish Norwegian German],
           Colour:      %i[Red Green White Blue Yellow],
           Pet:         %i[Dog Birds Cats Horse Zebra],
           Drink:       %i[Tea Coffee Milk Beer Water],
           Smoke:       %i[PallMall Dunhill BlueMaster Prince Blend]}

def adjacent?(n, i, g, e)
  (0..3).any? { |x| (n[x] == i && g[x + 1] == e) || (n[x + 1] == i && g[x] == e) }
end

def leftof?(n, i, g, e)
  (0..3).any? { |x| n[x] == i && g[x + 1] == e }
end

def coincident?(n, i, g, e)
  n.each_index.any? { |x| n[x] == i && g[x] == e }
end

def solve_zebra_puzzle
  CONTENT[:Nationality].each_permutation { |nation|
    next unless nation.first == :Norwegian # 10
    CONTENT[:Colour].each_permutation { |colour|
      next unless leftof?(colour, :Green, colour, :White)      # 5
      next unless coincident?(nation, :English, colour, :Red)  # 2
      next unless adjacent?(nation, :Norwegian, colour, :Blue) # 15
      CONTENT[:Pet].each_permutation { |pet|
        next unless coincident?(nation, :Swedish, pet, :Dog) # 3
        CONTENT[:Drink].each_permutation { |drink|
          next unless drink[2] == :Milk                           # 9
          next unless coincident?(nation, :Danish, drink, :Tea)   # 4
          next unless coincident?(colour, :Green, drink, :Coffee) # 6
          CONTENT[:Smoke].each_permutation { |smoke|
            next unless coincident?(smoke, :PallMall, pet, :Birds)    # 7
            next unless coincident?(smoke, :Dunhill, colour, :Yellow) # 8
            next unless coincident?(smoke, :BlueMaster, drink, :Beer) # 13
            next unless coincident?(smoke, :Prince, nation, :German)  # 14
            next unless adjacent?(smoke, :Blend, pet, :Cats)          # 11
            next unless adjacent?(smoke, :Blend, drink, :Water)       # 16
            next unless adjacent?(smoke, :Dunhill, pet, :Horse)       # 12
            print_out(nation, colour, pet, drink, smoke)
          }
        }
      }
    }
  }
end

def print_out(nation, colour, pet, drink, smoke)
  width = CONTENT.map { |k, v| {k.to_s.size, v.max_of { |y| y.to_s.size }}.max }
  fmt = width.map { |w| "%-#{w}s" }.join(" ")
  national = nation[pet.index(:Zebra).not_nil!]
  puts "The Zebra is owned by the man who is #{national}", ""
  puts fmt % CONTENT.keys, fmt % width.map { |w| "-" * w }
  [nation, colour, pet, drink, smoke].transpose.each.with_index(1) { |x, n| puts fmt % ([n] + x) }
end

solve_zebra_puzzle