Department numbers
You are encouraged to solve this task according to the task description, using any language you may know.
There is a highly organized city that has decided to assign a number to each of their departments:
- police department
- sanitation department
- fire department
Each department can have a number between 1 and 7 (inclusive).
The three department numbers are to be unique (different from each other) and must add up to the number 12.
The Chief of the Police doesn't like odd numbers and wants to have an even number for his department.
- Task
Write a program which outputs all valid combinations.
Possible output:
1 2 9
5 3 4
AppleScript
Composing a solution from generic functions.
<lang AppleScript>-- NUMBERING CONSTRAINTS ------------------------------------------------------
-- options :: Int -> Int -> Int -> [(Int, Int, Int)] on options(lo, hi, total)
set bind to flip(my concatMap) set ds to enumFromTo(lo, hi) script evenX on |λ|(x) script distinctY on |λ|(y) set z to total - (x + y) if y ≠ z and lo ≤ z and z ≤ hi then Template:X, y, z else {} end if end |λ| end script script notX on |λ|(d) d ≠ x end |λ| end script bind's |λ|(filter(notX, ds), distinctY) end |λ| end script bind's |λ|(filter(my even, ds), evenX)
end options
-- TEST -----------------------------------------------------------------------
on run
set xs to options(1, 7, 12) intercalate("\n\n", ¬ {"(Police, Sanitation, Fire)", ¬ unlines(map(show, xs)), ¬ "Number of options: " & |length|(xs)})
end run
-- GENERIC FUNCTIONS ----------------------------------------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs)
set lst to {} set lng to length of xs tell mReturn(f) repeat with i from 1 to lng set lst to (lst & |λ|(contents of item i of xs, i, xs)) end repeat end tell return lst
end concatMap
-- enumFromTo :: Int -> Int -> [Int] on enumFromTo(m, n)
if n < m then set d to -1 else set d to 1 end if set lst to {} repeat with i from m to n by d set end of lst to i end repeat return lst
end enumFromTo
-- even :: Int -> Bool on even(x)
x mod 2 = 0
end even
-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs)
tell mReturn(f) set lst to {} set lng to length of xs repeat with i from 1 to lng set v to item i of xs if |λ|(v, i, xs) then set end of lst to v end repeat return lst end tell
end filter
-- flip :: (a -> b -> c) -> (b -> a -> c) on flip(f)
script property g : f on |λ|(x, y) g(y, x) end |λ| end script
end flip
-- intercalate :: Text -> [Text] -> Text on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText} set strJoined to lstText as text set my text item delimiters to dlm return strJoined
end intercalate
-- length :: [a] -> Int on |length|(xs)
length of xs
end |length|
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f) set lng to length of xs set lst to {} repeat with i from 1 to lng set end of lst to |λ|(item i of xs, i, xs) end repeat return lst end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)
if class of f is script then f else script property |λ| : f end script end if
end mReturn
-- show :: a -> String on show(e)
set c to class of e if c = list then script serialized on |λ|(v) show(v) end |λ| end script "[" & intercalate(", ", map(serialized, e)) & "]" else if c = record then script showField on |λ|(kv) set {k, ev} to kv "\"" & k & "\":" & show(ev) end |λ| end script "{" & intercalate(", ", ¬ map(showField, zip(allKeys(e), allValues(e)))) & "}" else if c = date then "\"" & iso8601Z(e) & "\"" else if c = text then "\"" & e & "\"" else if (c = integer or c = real) then e as text else if c = class then "null" else try e as text on error ("«" & c as text) & "»" end try end if
end show
-- unlines :: [String] -> String on unlines(xs)
intercalate(linefeed, xs)
end unlines</lang>
- Output:
(Police, Sanitation, Fire) [2, 3, 7] [2, 4, 6] [2, 6, 4] [2, 7, 3] [4, 1, 7] [4, 2, 6] [4, 3, 5] [4, 5, 3] [4, 6, 2] [4, 7, 1] [6, 1, 5] [6, 2, 4] [6, 4, 2] [6, 5, 1] Number of options: 14
C++
<lang cpp>
- include <iostream>
- include <iomanip>
int main( int argc, char* argv[] ) {
int sol = 1; std::cout << "\t\tFIRE\t\tPOLICE\t\tSANITATION\n"; for( int f = 1; f < 8; f++ ) { for( int p = 1; p < 8; p++ ) { for( int s = 1; s < 8; s++ ) { if( f != p && f != s && p != s && !( p & 1 ) && ( f + s + p == 12 ) ) { std::cout << "SOLUTION #" << std::setw( 2 ) << sol++ << std::setw( 2 ) << ":\t" << std::setw( 2 ) << f << "\t\t " << std::setw( 3 ) << p << "\t\t" << std::setw( 6 ) << s << "\n"; } } } } return 0;
}</lang>
- Output:
FIRE POLICE SANITATION SOLUTION # 1: 1 4 7 SOLUTION # 2: 1 6 5 SOLUTION # 3: 2 4 6 SOLUTION # 4: 2 6 4 SOLUTION # 5: 3 2 7 SOLUTION # 6: 3 4 5 SOLUTION # 7: 4 2 6 SOLUTION # 8: 4 6 2 SOLUTION # 9: 5 4 3 SOLUTION #10: 5 6 1 SOLUTION #11: 6 2 4 SOLUTION #12: 6 4 2 SOLUTION #13: 7 2 3 SOLUTION #14: 7 4 1
Haskell
<lang Haskell>options :: Int -> Int -> Int -> [(Int, Int, Int)] options lo hi total =
let ds = [lo .. hi] in filter even ds >>= \x -> filter (/= x) ds >>= \y -> let z = total - (x + y) in [ (x, y, z) | y /= z && lo <= z && z <= hi ]
-- TEST ----------------------------------------------------------------------- main :: IO () main = do
let xs = options 1 7 12 putStrLn "(Police, Sanitation, Fire)\n" mapM_ print xs mapM_ putStrLn ["\nNumber of options: ", show (length xs)]</lang>
- Output:
(Police, Sanitation, Fire) (2,3,7) (2,4,6) (2,6,4) (2,7,3) (4,1,7) (4,2,6) (4,3,5) (4,5,3) (4,6,2) (4,7,1) (6,1,5) (6,2,4) (6,4,2) (6,5,1) Number of options: 14
JavaScript
ES6
By composition of generic functions.
<lang JavaScript>(() => {
'use strict';
// NUMBERING CONSTRAINTS --------------------------------------------------
// options :: Int -> Int -> Int -> [(Int, Int, Int)] const options = (lo, hi, total) => { const bind = flip(concatMap), ds = enumFromTo(lo, hi);
return bind(filter(even, ds), x => bind(filter(d => d !== x, ds), y => { const z = total - (x + y); return y !== z && lo <= z && z <= hi ? ( [ [x, y, z] ] ) : []; } ) ); };
// GENERIC FUNCTIONS ------------------------------------------------------
// concatMap :: (a -> [b]) -> [a] -> [b] const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
// enumFromTo :: Int -> Int -> [Int] const enumFromTo = (m, n) => Array.from({ length: Math.floor(n - m) + 1 }, (_, i) => m + i);
// even :: Integral a => a -> Bool const even = n => n % 2 === 0;
// filter :: (a -> Bool) -> [a] -> [a] const filter = (f, xs) => xs.filter(f);
// flip :: (a -> b -> c) -> b -> a -> c const flip = f => (a, b) => f.apply(null, [b, a]);
// length :: [a] -> Int const length = xs => xs.length;
// map :: (a -> b) -> [a] -> [b] const map = (f, xs) => xs.map(f);
// show :: a -> String const show = x => JSON.stringify(x) //, null, 2);
// unlines :: [String] -> String const unlines = xs => xs.join('\n');
// TEST ------------------------------------------------------------------- const xs = options(1, 7, 12); return '(Police, Sanitation, Fire)\n\n' + unlines(map(show, xs)) + '\n\nNumber of options: ' + length(xs);
})();</lang>
- Output:
(Police, Sanitation, Fire) [2,3,7] [2,4,6] [2,6,4] [2,7,3] [4,1,7] [4,2,6] [4,3,5] [4,5,3] [4,6,2] [4,7,1] [6,1,5] [6,2,4] [6,4,2] [6,5,1] Number of options: 14
Lua
<lang lua> print( "Fire", "Police", "Sanitation" ) sol = 0 for f = 1, 7 do
for p = 1, 7 do for s = 1, 7 do if s + p + f == 12 and p % 2 == 0 and f ~= p and f ~= s and p ~= s then print( f, p, s ); sol = sol + 1 end end end
end print( string.format( "\n%d solutions found", sol ) ) </lang>
- Output:
Fire Police Sanitation 1 4 7 1 6 5 2 4 6 2 6 4 3 2 7 3 4 5 4 2 6 4 6 2 5 4 3 5 6 1 6 2 4 6 4 2 7 2 3 7 4 1 14 solutions found
Perl
<lang Perl>
- !/usr/bin/perl
my @even_numbers;
for (1..7) {
if ( $_ % 2 == 0) { push @even_numbers, $_; }
}
print "Police\tFire\tSanitation\n";
foreach my $police_number (@even_numbers) {
for my $fire_number (1..7) { for my $sanitation_number (1..7) { if ( $police_number + $fire_number + $sanitation_number == 12 && $police_number != $fire_number && $fire_number != $sanitation_number && $sanitation_number != $police_number) { print "$police_number\t$fire_number\t$sanitation_number\n"; } } }
} </lang>
Perl 6
<lang perl6>for (1..7).combinations(3).grep(*.sum == 12) {
for .permutations\ .grep(*.[0] %% 2) { say <police fire sanitation> Z=> .list; }
} </lang>
- Output:
(police => 4 fire => 1 sanitation => 7) (police => 4 fire => 7 sanitation => 1) (police => 6 fire => 1 sanitation => 5) (police => 6 fire => 5 sanitation => 1) (police => 2 fire => 3 sanitation => 7) (police => 2 fire => 7 sanitation => 3) (police => 2 fire => 4 sanitation => 6) (police => 2 fire => 6 sanitation => 4) (police => 4 fire => 2 sanitation => 6) (police => 4 fire => 6 sanitation => 2) (police => 6 fire => 2 sanitation => 4) (police => 6 fire => 4 sanitation => 2) (police => 4 fire => 3 sanitation => 5) (police => 4 fire => 5 sanitation => 3)
REXX
A little extra code was added to allow the specification for the high department number as well as the sum.
Also, extra code was added to nicely format a title (header) for the output, as well as displaying the number of solutions found. <lang rexx>/*REXX program finds/displays all possible variants of (3) department numbering puzzle.*/ parse arg high sum . /*obtain optional arguments from the CL*/ if high== | high=="," then high= 7 /*Not specified? Then use the default.*/ if sum== | sum=="," then sum=12 /* " " " " " " */ @pd= ' police '; @fd= " fire " ; @sd= ' sanitation ' /*define names of departments.*/ @dept= ' department '; L=length(@dept) /*literal; and also its length*/
- =0 /*initialize the number of solutions. */
do PD=2 by 2 to high /*try numbers for the police department*/ do FD=1 for high /* " " " " fire " */ if FD==PD then iterate /*Same FD# & PD#? They must be unique.*/ if FD+PD>sum-1 then iterate PD /*Is sum too large? Try another PD#. */ do SD=1 for high /*try numbers for the sanitation dept. */ if SD==PD | SD==FD then iterate /*Is SD# ¬unique? They must be unique,*/ $=PD+FD+SD /*compute sum of department numbers. */ if $> sum then iterate FD /*Is the sum too high? Try another FD#*/ if $\==sum then iterate /*Is the sum ¬correct? " " SD#*/ #=# + 1 /*bump the number of solutions (so far)*/ if #==1 then do /*Is this the 1st solution? Show hdr.*/ say center(@pd, L) center(@fd, L) center(@sd, L) say copies(center( @dept, L)' ', 3) say copies(center('number', L)' ', 3) say center(, L, "═") center(, L, "═") center(, L, "═") end say center(PD, L) center(FD, L) center(SD, L) /*display a solution.*/ end /*SD*/ end /*FD*/ end /*PD*/
say /*display a blank line before the #sols*/ if #==0 then #= 'no' /*use a better word for bupkis. */ say # "solutions found." /*stick a fork in it, we're all done. */</lang>
- output when using the default inputs:
police fire sanitation department department department number number number ════════════ ════════════ ════════════ 2 3 7 2 4 6 2 6 4 2 7 3 4 1 7 4 2 6 4 3 5 4 5 3 4 6 2 4 7 1 6 1 5 6 2 4 6 4 2 6 5 1 14 solutions found.
zkl
<lang zkl>Utils.Helpers.pickNFrom(3,[1..7].walk()) // 35 combos .filter(fcn(numbers){ numbers.sum(0)==12 }) // which all sum to 12 (==5) .filter("apply","isEven") // at least one number is even .println();</lang>
- Output:
L(L(1,4,7),L(1,5,6),L(2,3,7),L(2,4,6),L(3,4,5))
For a table with repeated solutions: <lang zkl>ns:=Utils.Helpers.pickNFrom(3,[1..7].walk()) // 35 combos
.filter(fcn(numbers){ numbers.sum(0)==12 }) // which all sum to 12 (==5) .filter("apply","isEven") // at least one number is even .pump(List,Utils.Helpers.permute) // expand 5 results --> list of lists .flatten() // ( (),()..) --> () .filter(fcn([(p,_,_)]){ p.isEven }); // with even first number
println("Police Fire Sanitation"); foreach pfs in (ns){ "%d\t%d\t%d".fmt(pfs.xplode()).println() }</lang>
- Output:
Police Fire Sanitation 4 7 1 4 1 7 6 1 5 6 5 1 2 3 7 2 7 3 2 4 6 2 6 4 6 2 4 6 4 2 4 6 2 4 2 6 4 5 3 4 3 5