UEFA Euro 2020 full Lisp computer

[Emanuel Berg via Users list for the GNU Emacs text editor <help-gnu-emacs@gnu.org>]

Okay guys, check this out if it makes any sense ... 

So this is version 1, version 2 will be version 1 + your
improvements + an interface so you can ask the questions
hinted at at the end of the docstring. Then it'll get REALLY
interesting! Well, that's the plan anyway, keep it real and
enjoy the tournament ...

;;; -*- lexical-binding: t -*-
;;;
;;; this file:
;;;   http://user.it.uu.se/~embe8573/emacs-init/uefa.el
;;;   https://dataswamp.org/~incal/emacs-init/uefa.el
;;;
;;; With x teams per group where every team faces every other
;;; team in 1 game that's a total of (x - 1)! games. E.g., for
;;; 4 teams that's 3! = 6 games.
;;;
;;; With the teams denoted as a, b, c, and d, the games are
;;; a-b, a-c, a-d, b-c, b-d, and c-d. (In alpha order and
;;; without implying what team is the home team in a game.)
;;;
;;; A game is either a win (3 points), a draw (1 point) or
;;; a loss (0 points). With 6 games in a group, that's
;;; 3**6 = 729 possible outcomes per group. For groups A-F,
;;; i.e. 6 groups, that's 729**6 = 150 094 635 296 999 121
;;; possible outcomes! But that's not all of it...
;;;
;;; In each group, the teams to finish in 1st or 2nd place,
;;; i.e. the winner and the runner-up, qualifies to the next
;;; round, as well as the 4 best teams to finish in 3rd place.
;;; With 6 groups that's 2*6 + 4 = 16 teams that qualifies -
;;; to the round of 16 (makes sense).
;;;
;;; In the code below, the alpha sequence of games above and
;;; the points awarded are used to express the group games
;;; results as a list. E.g., the list
;;;
;;;   (3 3 0 3 1 0)
;;;
;;; means that in the game between teams a and b, a won; a-c,
;;; a won; a-d, d won; b-c, b won; b-d, a draw; and c-d,
;;; d won. This outcome translates to the this table
;;;
;;;   T G W D L P (team, games, wins, draws, losses, points)
;;;   -----------
;;;   d 3 2 1 0 7
;;;   a 3 2 0 1 6
;;;   b 3 1 1 1 4
;;    c 3 0 0 3 0
;;;
;;; There are actually more outcomes than 729 because teams
;;; can end up with the same number of points. The tie-braker
;;; is then the goal difference. Because the goal difference
;;; can either favor or disfavor any team x with the same
;;; points as any team y, every permutations of such teams
;;; must be given their own final table and so adds 1 to the
;;; total number of outcomes. E.g., if all teams end up on
;;; 4 points, which for example happens with this sequence of
;;; game results
;;;
;;;   (3 1 0 3 1 3)
;;;
;;; then one possible final table is
;;;
;;;   T G W D L P
;;;   -----------
;;;   a 3 1 1 1 4
;;;   b 3 1 1 1 4
;;;   c 3 1 1 1 4
;;;   d 3 1 1 1 4
;;;
;;; but equally possible is every other permutation of
;;; (a b c d). For x teams, the number of possible
;;; permutations is x! so for 4 teams it is 4! = 24; for
;;; 3 teams with the same points, permutations are 3! = 6
;;; tables; and for 2 teams, 2! = 2 tables. For 2 teams with
;;; the same points, where the other 2 teams also have the
;;; same points (that differ from the first two teams), as in
;;; this sequence
;;;
;;;   (1 3 3 3 3 1)
;;;
;;; the number of permutations is 2!**2 = 4. Here is one
;;; possible such table
;;;
;;;   T G W D L P
;;;   -----------
;;;   b 3 2 1 0 7
;;;   a 3 2 1 0 7
;;;   d 3 0 1 2 1
;;;   c 3 0 1 2 1
;;;
;;; but, again, for that same outcome with respect to wins,
;;; draws, and losses, there are 3 other possible tables,
;;; namely, if we call the above table (b a d c), there are
;;; also tables (a b c d), (a b d c), and (b a c d)!
;;;
;;; Including those permutations, the number of possible
;;; tables per group is 1512 - if the programming below is
;;; correct... I don't know how to express it mathematically,
;;; but the programming does check out for the just mentioned
;;; cases
;;;
;;;   (length (uefa-perms (uefa-make-table '(3 1 0 3 1 3)))) ; 24
;;;   (length (uefa-perms (uefa-make-table '(3 3 0 3 1 0)))) ;  1
;;;   (length (uefa-perms (uefa-make-table '(1 3 3 3 3 1)))) ;  4
;;;
;;; TODO: - number of teams not hard-coded
;;;       - expand from one group to 6 (A-F), including overall
;;;         4 best 3rd place teams
;;;       - answer questions like, "do you always finish 1st
;;;         if you win 2 games?", "can you fail to qualify
;;;         with one win and one draw", etc
;;;       - the sky is the limit...

(require 'cl-lib)

(defun uefa-get-all-outcomes ()
  (let ((res '()))
    (cl-labels ((get-all (games)
                   (if (= (length games) 6)
                       (push games res)
                     (get-all `(,@games 3))
                     (get-all `(,@games 1))
                     (get-all `(,@games 0)) )))
      (get-all '()) )
    res) )
;; (length (uefa-get-all-outcomes)) ; 729

(defun uefa-compare-teams (team-1 team-2)
  (let ((team-1-pts (car (last team-1)))
        (team-2-pts (car (last team-2))) )
    (>= team-1-pts team-2-pts) ))

(defun uefa-sort-table (table)
  (sort table #'uefa-compare-teams) )

(defun uefa-same-points-p (team-1 team-2)
  (let ((team-1-pts (car (last team-1)))
        (team-2-pts (car (last team-2))) )
    (= team-1-pts team-2-pts) ))

(defun uefa-print-team (team)
  (format "%s %s %s %s %s %s"
    (nth 0 team) (nth 1 team) (nth 2 team)
    (nth 3 team) (nth 4 team) (nth 5 team) ))

(defun uefa-print-table (tbl)
    (message (format "\nT G W D L P\n-----------"))
    (cl-loop for team in tbl do
      (message (uefa-print-team team)) ))
;; (uefa-print-table (uefa-make-table '(3 1 0 3 1 3)))

(defun uefa-print-tables (tbls)
  (cl-loop for tbl in tbls do
    (uefa-print-table tbl) ))
;; (uefa-print-tables (uefa-perms (uefa-make-table '(3 1 0 3 1 3))))

(defun uefa-swap (i j lst)
  (let*((new-lst (copy-sequence lst))
        (el      (nth i new-lst)) )
    (setf (nth i new-lst) (nth j new-lst))
    (setf (nth j new-lst) el)
    new-lst) )

(defun uefa-perm-swaps (table)
  (let*((len   (1- (length table)))
        (swaps (make-list len '())) )
    (cl-loop for i in table
             for index-i from 0 to len do
      (cl-loop for j in (cdr (member i table))
               for index-j from (1+ index-i) to len do
        (when (uefa-same-points-p i j)
          (push (list index-i index-j) (nth index-i swaps)) )))
    swaps) )
;; (uefa-perm-swaps (uefa-make-table '(3 1 0 3 1 3)))

(defun uefa-perms (table)
  (let ((swaps (uefa-perm-swaps table))
        (done  '()) )
    (cl-labels ((perms-tbl (swps tbl)
                  (if swps
                      (let ((next (cdr swps)))
                        (cl-loop for s in (car swps) do
                          (perms-tbl next (uefa-swap (car s) (cadr s) tbl)) )
                        (perms-tbl next tbl) )
                    (push tbl done) )))
      (perms-tbl swaps table)
      done) ))
;; (length (uefa-perms (uefa-make-table '(3 1 0 3 1 3)))) ; 24
;; (length (uefa-perms (uefa-make-table '(3 3 0 3 1 0)))) ;  1

(defun uefa-losses (games wins draws)
  (- games (+ wins draws)) )

(defun uefa-points (wins draws)
  (+ (* wins 3) draws) )

(defun uefa-make-table (outcome &optional team-a team-b team-c team-d)
  (let ((a (or team-a "a"))
        (b (or team-b "b"))
        (c (or team-c "c"))
        (d (or team-d "d"))
        (games 3)
        (a-wins 0) (a-draws 0)
        (b-wins 0) (b-draws 0)
        (c-wins 0) (c-draws 0)
        (d-wins 0) (d-draws 0)
        (a-b (nth 0 outcome))
        (a-c (nth 1 outcome))
        (a-d (nth 2 outcome))
        (b-c (nth 3 outcome))
        (b-d (nth 4 outcome))
        (c-d (nth 5 outcome)) )

    (cond ((= a-b 3) (cl-incf a-wins))
          ((= a-b 1) (cl-incf a-draws) (cl-incf b-draws))
          ((= a-b 0) (cl-incf b-wins)) )

    (cond ((= a-c 3) (cl-incf a-wins))
          ((= a-c 1) (cl-incf a-draws) (cl-incf c-draws))
          ((= a-c 0) (cl-incf c-wins)) )

    (cond ((= a-d 3) (cl-incf a-wins))
          ((= a-d 1) (cl-incf a-draws) (cl-incf d-draws))
          ((= a-d 0) (cl-incf d-wins)) )

    (cond ((= b-c 3) (cl-incf b-wins))
          ((= b-c 1) (cl-incf b-draws) (cl-incf c-draws))
          ((= b-c 0) (cl-incf c-wins)) )

    (cond ((= b-d 3) (cl-incf b-wins))
          ((= b-d 1) (cl-incf b-draws) (cl-incf d-draws))
          ((= b-d 0) (cl-incf d-wins)) )

    (cond ((= c-d 3) (cl-incf c-wins))
          ((= c-d 1) (cl-incf c-draws) (cl-incf d-draws))
          ((= c-d 0) (cl-incf d-wins)) )

    (let ((a-losses (uefa-losses games a-wins a-draws))
          (b-losses (uefa-losses games b-wins b-draws))
          (c-losses (uefa-losses games c-wins c-draws))
          (d-losses (uefa-losses games d-wins d-draws))
          (a-pts    (uefa-points       a-wins a-draws))
          (b-pts    (uefa-points       b-wins b-draws))
          (c-pts    (uefa-points       c-wins c-draws))
          (d-pts    (uefa-points       d-wins d-draws)) )
      (uefa-sort-table
       (list
        (list a games a-wins a-draws a-losses a-pts)
        (list b games b-wins b-draws b-losses b-pts)
        (list c games c-wins c-draws c-losses c-pts)
        (list d games d-wins d-draws d-losses d-pts) )))))
;; (uefa-make-table '(3 3 0 3 1 0))

(defun uefa-get-all-tables ()
  (let ((res (uefa-get-all-outcomes))
        (tables '()) )
    (cl-loop for r in res do
      (setq tables `(,@tables ,@(uefa-perms (uefa-make-table r)))) )
    tables) )
;; (length (uefa-get-all-tables)) ; 1512

-- 
underground experts united
https://dataswamp.org/~incal