add zebra-puzzle, part of 48 in 24

config.json

@@ -878,6 +878,14 @@
         "practices": [],
         "prerequisites": [],
         "difficulty": 6
+      },
+      {
+        "slug": "zebra-puzzle",
+        "name": "Zebra Puzzle",
+        "uuid": "bd7c4195-2d89-436b-918f-24224a95610d",
+        "practices": [],
+        "prerequisites": [],
+        "difficulty": 5
       }
     ]
   },

exercises/practice/zebra-puzzle/.docs/instructions.md

@@ -0,0 +1,32 @@
+# Instructions
+
+Your task is to solve the Zebra Puzzle to find the answer to these two questions:
+
+- Which of the residents drinks water?
+- Who owns the zebra?
+
+## Puzzle
+
+The following 15 statements are all known to be true:
+
+1. There are five houses.
+2. The Englishman lives in the red house.
+3. The Spaniard owns the dog.
+4. Coffee is drunk in the green house.
+5. The Ukrainian drinks tea.
+6. The green house is immediately to the right of the ivory house.
+7. The Old Gold smoker owns snails.
+8. Kools are smoked in the yellow house.
+9. Milk is drunk in the middle house.
+10. The Norwegian lives in the first house.
+11. The man who smokes Chesterfields lives in the house next to the man with the fox.
+12. Kools are smoked in the house next to the house where the horse is kept.
+13. The Lucky Strike smoker drinks orange juice.
+14. The Japanese smokes Parliaments.
+15. The Norwegian lives next to the blue house.
+
+Additionally, each of the five houses is painted a different color, and their inhabitants are of different national extractions, own different pets, drink different beverages and smoke different brands of cigarettes.
+
+~~~~exercism/note
+There are 24 billion (5!⁵ = 24,883,200,000) possible solutions, so try ruling out as many solutions as possible.
+~~~~

exercises/practice/zebra-puzzle/.docs/introduction.md

@@ -0,0 +1,15 @@
+# Introduction
+
+The Zebra Puzzle is a famous logic puzzle in which there are five houses, each painted a different color.
+The houses have different inhabitants, who have different nationalities, own different pets, drink different beverages and smoke different brands of cigarettes.
+
+To help you solve the puzzle, you're given 15 statements describing the solution.
+However, only by combining the information in _all_ statements will you be able to find the solution to the puzzle.
+
+~~~~exercism/note
+The Zebra Puzzle is a [Constraint satisfaction problem (CSP)][constraint-satisfaction-problem].
+In such a problem, you have a set of possible values and a set of constraints that limit which values are valid.
+Another well-known CSP is Sudoku.
+
+[constraint-satisfaction-problem]: https://en.wikipedia.org/wiki/Constraint_satisfaction_problem
+~~~~

exercises/practice/zebra-puzzle/.meta/config.json

@@ -0,0 +1,19 @@
+{
+  "authors": [
+    "kmarker1101"
+  ],
+  "files": {
+    "solution": [
+      "zebra-puzzle.el"
+    ],
+    "test": [
+      "zebra-puzzle-test.el"
+    ],
+    "example": [
+      ".meta/example.el"
+    ]
+  },
+  "blurb": "Solve the zebra puzzle.",
+  "source": "Wikipedia",
+  "source_url": "https://en.wikipedia.org/wiki/Zebra_Puzzle"
+}

exercises/practice/zebra-puzzle/.meta/example.el

@@ -0,0 +1,157 @@
+;;; zebra-puzzle.el --- Zebra Puzzle (exercism)  -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar all-houses nil)
+
+(defvar house-constraints nil)
+
+(defvar feasible-houses nil)
+
+(defvar street-constraints nil)
+
+(defvar two-house-constraints nil)
+
+(defvar feasible-streets nil)
+
+(defvar all-streets nil)
+
+(defvar houses-by-number nil)
+
+(cl-defstruct house
+  number color owner pet drink smokes)
+
+(setq all-houses
+      (cl-loop for n in '(1 2 3 4 5)
+               append (cl-loop for c in '(red green ivory yellow blue)
+                               append (cl-loop for o in '(Englishman Spaniard Ukrainian Norwegian Japanese)
+                                               append (cl-loop for p in '(dog snails fox horse zebra)
+                                                               append (cl-loop for d in '(coffee tea milk orange-juice water)
+                                                                               append (cl-loop for s in '(Old-Gold Kools Chesterfields Lucky-Strike Parliaments)
+                                                                                               collect (make-house :number n :color c :owner o :pet p :drink d :smokes s))))))))
+
+(setq house-constraints
+      (list
+       (lambda (h) (equal (equal (house-owner h) 'Englishman)
+		     (equal (house-color h) 'red)))
+       (lambda (h) (equal (equal (house-owner h) 'Spaniard)
+		     (equal (house-pet h) 'dog)))
+       (lambda (h) (equal (equal (house-drink h) 'coffee)
+		     (equal (house-color h) 'green)))
+       (lambda (h) (equal (equal (house-owner h) 'Ukrainian)
+		     (equal (house-drink h) 'tea)))
+       (lambda (h) (equal (equal (house-smokes h) 'Old-Gold)
+		     (equal (house-pet h) 'snails)))
+       (lambda (h) (equal (equal (house-smokes h) 'Kools)
+		     (equal (house-color h) 'yellow)))
+       (lambda (h) (equal (equal (house-drink h) 'milk)
+		     (= (house-number h) 3)))
+       (lambda (h) (equal (equal (house-owner h) 'Norwegian)
+		     (= (house-number h) 1)))
+       (lambda (h) (equal (equal (house-smokes h) 'Lucky-Strike)
+		     (equal (house-drink h) 'orange-juice)))
+       (lambda (h) (equal (equal (house-owner h) 'Japanese)
+		     (equal (house-smokes h) 'Parliaments)))
+       (lambda (h) (equal (= (house-number h) 2)
+		     (equal (house-color h) 'blue)))
+       (lambda (h) (if (equal (house-color h) 'green)
+		  (not (= (house-number h) 1))
+		t))
+       (lambda (h) (if (equal (house-color h) 'ivory)
+		  (not (= (house-number h) 5))
+		t))))
+
+(defun apply-constraints (constraints items)
+  "Apply a list of CONSTRAINTS to a list of ITEMS."
+  (cl-loop for constraint in constraints
+           do (setq items (cl-remove-if-not constraint items))
+           finally return items))
+
+(setq feasible-houses
+      (apply-constraints house-constraints all-houses))
+
+(defun next-door? (h1 h2)
+  "Check if two houses, H1 and H2, are next to each other."
+  (= (abs (- (house-number h1) (house-number h2))) 1))
+
+(setq two-house-constraints
+      (list
+       (lambda (h1 h2)
+         (if (and (equal (house-color h1) 'green)
+                  (equal (house-color h2) 'ivory))
+             (= (house-number h1) (1+ (house-number h2)))
+           t))
+       (lambda (h1 h2)
+         (if (and (equal (house-smokes h1) 'Chesterfields)
+                  (equal (house-pet h2) 'fox))
+             (next-door? h1 h2)
+           t))
+       (lambda (h1 h2)
+         (if (and (equal (house-smokes h1) 'Kools)
+                  (equal (house-pet h2) 'horse))
+             (next-door? h1 h2)
+           t))))
+
+(defun check-street (constraint street)
+  "Check if all pairs of houses in STREET satisfy CONSTRAINT."
+  (cl-loop for h1 in street
+           always (cl-loop for h2 in street
+                           always (funcall constraint h1 h2))))
+
+(setq street-constraints
+      (mapcar (lambda (c)
+                (lambda (s) (check-street c s)))
+              two-house-constraints))
+
+(setq houses-by-number
+      (cl-loop for n in '(1 2 3 4 5)
+               collect (cl-remove-if-not (lambda (h) (= n (house-number h))) feasible-houses)))
+
+(defun disjoint? (h1 h2)
+  "Check if two houses, H1 and H2, are disjoint in terms of their attributes."
+  (not (or (equal (house-color h1) (house-color h2))
+           (equal (house-owner h1) (house-owner h2))
+           (equal (house-pet h1) (house-pet h2))
+           (equal (house-drink h1) (house-drink h2))
+           (equal (house-smokes h1) (house-smokes h2)))))
+
+(defun extends? (street h)
+  "Check if a house, H, can be added to a STREET."
+  (cl-every (lambda (h1) (disjoint? h h1)) street))
+
+(defun build-streets (houses street)
+  "Recursively build all possible STREET with HOUSES."
+  (if (null houses)
+      (list street)
+    (cl-loop for h in (car houses)
+             when (extends? street h)
+             append (build-streets (cdr houses) (cons h street)))))
+
+(setq all-streets
+      (build-streets houses-by-number '()))
+
+(setq feasible-streets
+      (apply-constraints street-constraints all-streets))
+
+(defun find-owner (condition)
+  "Find the owner of a house based on a CONDITION."
+  (if (= 1 (length feasible-streets))
+      (cl-loop for h in (car feasible-streets)
+               if (funcall condition h)
+               return (house-owner h))
+    nil))
+
+(defun owns-zebra ()
+  "Find the owner of the zebra."
+  (find-owner (lambda (h) (equal (house-pet h) 'zebra))))
+
+(defun drinks-water ()
+  "Find the owner of the house where water is drunk."
+  (find-owner (lambda (h) (equal (house-drink h) 'water))))
+
+(provide 'zebra-puzzle)
+;;; zebra-puzzle.el ends here

exercises/practice/zebra-puzzle/.meta/tests.toml

@@ -0,0 +1,16 @@
+# This is an auto-generated file.
+#
+# Regenerating this file via `configlet sync` will:
+# - Recreate every `description` key/value pair
+# - Recreate every `reimplements` key/value pair, where they exist in problem-specifications
+# - Remove any `include = true` key/value pair (an omitted `include` key implies inclusion)
+# - Preserve any other key/value pair
+#
+# As user-added comments (using the # character) will be removed when this file
+# is regenerated, comments can be added via a `comment` key.
+
+[16efb4e4-8ad7-4d5e-ba96-e5537b66fd42]
+description = "resident who drinks water"
+
+[084d5b8b-24e2-40e6-b008-c800da8cd257]
+description = "resident who owns zebra"

exercises/practice/zebra-puzzle/zebra-puzzle-test.el

@@ -0,0 +1,22 @@
+;;; zebra-puzzle-test.el --- Zebra Puzzle (exercism)  -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+
+(load-file "zebra-puzzle.el")
+(declare-function drinks-water "zebra-puzzle.el" ())
+(declare-function owns-zebra "zebra-puzzle.el" ())
+
+
+(ert-deftest resident-who-drinks-water ()
+  (should (string= (drinks-water) "Norwegian")))
+
+
+(ert-deftest resident-who-owns-zebra ()
+  (should (string= (owns-zebra) "Japanese")))
+
+
+(provide 'zebra-puzzle-test)
+;;; zebra-puzzle-test.el ends here

exercises/practice/zebra-puzzle/zebra-puzzle.el

@@ -0,0 +1,18 @@
+;;; zebra-puzzle.el --- Zebra Puzzle (exercism)  -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+
+(defun drinks-water ()
+  (error "Delete this S-Expression and write your own implementation"))
+
+
+(defun owns-zebra ()
+  (error "Delete this S-Expression and write your own implementation"))
+
+
+(provide 'zebra-puzzle)
+;;; zebra-puzzle.el ends here
+