Snooker
March 30, 2018
Here is our solution:
(define colors '(black pink blue brown green yellow red)) (define (points color) (length (member color colors))) (define (scores xs) (cdr (scan + 0 (map points xs)))) (define perfect (append (copies 15 '(red black)) '(yellow green brown blue pink black))) > (scores perfect) (1 8 9 16 17 24 25 32 33 40 41 48 49 56 57 64 65 72 73 80 81 88 89 96 97 104 105 112 113 120 122 125 129 134 140 147)
You can run the program at https://ideone.com/AQtuyB.
Programming Praxis 
Couldn’t resist perl golf
[sourcecode language="perl"]
say”@{[map{$t+=$_}(map{(1,7)}1..15),2..7]}”
[sourcecode]
I interpreted the question to require mapping a sequence of potted
balls (including fouls) to scores, so this code handles such cases.
However, my knowledge of snooker rules is limited to what’s mentioned
in the question, so only those violations are caught.
(import (scheme base) (scheme write) (srfi 2)) ;; State of the game: config[i] = # of balls of value i on table, for ;; 0 < i < 8. config[0], if nonzero, is the value of the last potted ;; ball. (define (initial-config) (vector 0 15 1 1 1 1 1 1)) ;; Colors of balls (define ball-color '#(#f "red" "yellow" "green" "brown" "blue" "pink" "black")) ;; A break is represented as a sequence of values of potted balls. ;; Here's a perfect game, which should score to 147 points: (define perfect-game (append (apply append (make-list 15 '(1 7))) '(2 3 4 5 6 7))) (define (vector-decrement! vec idx) (vector-set! vec idx (- (vector-ref vec idx) 1))) ;; Update game configuration cfg (in place) to record ball being ;; potted. Return the points scored, or #f if ball is not on table. (define (pot-ball! cfg ball) (and (positive? (vector-ref cfg ball)) ; else impossible => #f ;; Check for scratch (config remains as is and no points awarded) (if (and (positive? (vector-ref cfg 1)) (not (= 1 ball)) (not (= 1 (vector-ref cfg 0)))) 0 (begin (when (or (= ball 1) (and (zero? (vector-ref cfg 1)) (not (= 1 (vector-ref cfg 0))))) (vector-decrement! cfg ball)) (vector-set! cfg 0 ball) ball)))) (define (game-score-sequence balls) (let ((cfg (initial-config))) (let f ((balls balls) (scores '(0))) (if (null? balls) (cdr (reverse scores)) (and-let* ((points (pot-ball! cfg (car balls)))) (f (cdr balls) (cons (+ (car scores) points) scores))))))) (display (game-score-sequence perfect-game)) (newline)Here’s a solution in Python 3.
Output:
Here’s a solution in C.
[sourecode lang=”c”]
/* snooker.c */
#include <stdio.h>
#include <stdlib.h>
#define NUM_POTS 36
void print_array(int* array, size_t n) {
printf(“[“);
for (size_t i = 0; i < n; ++i) {
if (i > 0) printf(“, “);
printf(“%d”, array[i]);
}
printf(“]\n”);
}
void accumulate(int* array, size_t n) {
for (size_t i = 1; i < n; ++i) {
array[i] += array[i-1];
}
}
void calc_perfect_game(int* scores) {
for (size_t i = 0; i < 15; ++i) {
scores[i2] = 1;
scores[i2 + 1] = 7;
}
for (size_t i = 0; i < 6; ++i) {
scores[i+30] = i + 2;
}
accumulate(scores, NUM_POTS);
}
int main(void) {
int scores[NUM_POTS];
calc_perfect_game(scores);
print_array(scores, NUM_POTS);
return EXIT_SUCCESS;
}
[/sourcecode]
Output:
I spelled “sourcecode” wrong. Here it is again with the correct spelling (and formatting).
/* snooker.c */
#include <stdio.h>
#include <stdlib.h>
#define NUM_POTS 36
void print_array(int* array, size_t n) {
printf("[");
for (size_t i = 0; i < n; ++i) {
if (i > 0) printf(", ");
printf("%d", array[i]);
}
printf("]\n");
}
void accumulate(int* array, size_t n) {
for (size_t i = 1; i < n; ++i) {
array[i] += array[i-1];
}
}
void calc_perfect_game(int* scores) {
for (size_t i = 0; i < 15; ++i) {
scores[i*2] = 1;
scores[i*2 + 1] = 7;
}
for (size_t i = 0; i < 6; ++i) {
scores[i+30] = i + 2;
}
accumulate(scores, NUM_POTS);
}
int main(void) {
int scores[NUM_POTS];
calc_perfect_game(scores);
print_array(scores, NUM_POTS);
return EXIT_SUCCESS;
}
Output:
Last try…
/* snooker.c */ #include <stdio.h> #include <stdlib.h> #define NUM_POTS 36 void print_array(int* array, size_t n) { printf("["); for (size_t i = 0; i < n; ++i) { if (i > 0) printf(", "); printf("%d", array[i]); } printf("]\n"); } void accumulate(int* array, size_t n) { for (size_t i = 1; i < n; ++i) { array[i] += array[i-1]; } } void calc_perfect_game(int* scores) { for (size_t i = 0; i < 15; ++i) { scores[i*2] = 1; scores[i*2 + 1] = 7; } for (size_t i = 0; i < 6; ++i) { scores[i+30] = i + 2; } accumulate(scores, NUM_POTS); } int main(void) { int scores[NUM_POTS]; calc_perfect_game(scores); print_array(scores, NUM_POTS); return EXIT_SUCCESS; }Output:
Here’s a Haskell version. For fun we generate a random snooker game.
import Prelude hiding ((++)) import Control.Monad.Random import Data.Vector (Vector, (++)) import qualified Data.Vector as V import qualified Data.Vector.Mutable as M import Text.Printf (printf) data Ball = Red | Yellow | Green | Brown | Blue | Pink | Black deriving (Enum) -- The number of points awarded for potting a ball. points :: Ball -> Int points = (+1) . fromEnum -- The 15 red balls. reds :: Vector Ball reds = V.replicate 15 Red -- The remaining coloured (non-red) balls. coloureds :: Vector Ball coloureds = V.enumFromTo Yellow Black -- A series of balls corresponding to a random game in which one player pots one -- ball per shot. -- -- We construct a game by generating the sequence of shots: -- -- r, c, r, c, ..., r, c, c, c, c, c, c, c -- +-------------------+ +--------------+ -- 15 (r,c) pairs final 6 cs -- -- which consists of 15 pairs of a red ball, and a coloured ball chosen randomly -- (with replacement), followed by all the coloured balls in increasing order of -- points. randomGame :: Rand StdGen (Vector Ball) randomGame = do cols <- randomSelection (V.length reds) coloureds return $ unpair (V.zip reds cols) ++ coloureds -- Show the accumulation of points for a sequence of potted balls. score :: Vector Ball -> String score = unwords . map show . V.toList . V.postscanl (+) 0 . V.map points -- The sequence of balls potted in a perfect game. perfect :: Vector Ball perfect = let blacks = V.map (const Black) reds in unpair (V.zip reds blacks) ++ coloureds main :: IO () main = do rand <- getStdGen printf "perfect: %s\n" $ score perfect printf " random: %s\n" $ score $ evalRand randomGame rand -- -- Utility functions -- -- Given [(a, b), (c, d), ...] return [a, b, c, d, ...]. unpair :: Vector (a, a) -> Vector a unpair xs = V.create $ do ys <- M.new (2 * V.length xs) V.imapM_ (\i (x1, x2) -> M.write ys (2*i) x1 >> M.write ys (2*i+1) x2) xs return ys -- A random selection of size n from v, with replacement. randomSelection :: MonadRandom m => Int -> Vector a -> m (Vector a) randomSelection n xs = V.backpermute xs <$> V.replicateM n (getRandomR (0, V.length xs - 1))