Department numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
(Haskell, JS ES6, and AppleScript : binding y (middle digit) to a filtered digit list ( filter (/= x) ))
Line 41: Line 41:
script distinctY
script distinctY
on |λ|(y)
on |λ|(y)
if x ≠ y then
set z to total - (x + y)
set z to total - (x + y)
if y ≠ z and lo ≤ z and z ≤ hi then
if y ≠ z and lo ≤ z and z ≤ hi then
{{x, y, z}}
⚫
{{x, y, z}}
⚫
else
⚫
{}
⚫
end if
else
else
{}
{}
Line 54: Line 50:
end script
end script
bind's |λ|(ds, distinctY)
script notX
⚫
on |λ|(d)
⚫
d ≠ x
⚫
end |λ|
⚫
end script
⚫
bind's |λ|(filter(notX, ds), distinctY)
end |λ|
end |λ|
end script
end script
Line 274: Line 276:
in filter even ds >>=
in filter even ds >>=
\x ->
\x ->
ds >>=
filter (/= x) ds >>=
\y ->
\y ->
if x /= y
let z = total - (x + y)
then let z = total - (x + y)
in [ (x, y, z)
in [ (x, y, z)
| y /= z && lo <= z && z <= hi ]
| y /= z && lo <= z && z <= hi ]
⚫
else []


-- TEST -----------------------------------------------------------------------
-- TEST -----------------------------------------------------------------------
Line 325: Line 325:


return bind(filter(even, ds),
return bind(filter(even, ds),
x => bind(ds,
x => bind(filter(d => d !== x, ds),
y => x !== y ?
y => {
(() => {
const z = total - (x + y);
const z = total - (x + y);
return y !== z && lo <= z && z <= hi ? (
return y !== z && lo <= z && z <= hi ? (
Line 334: Line 333:
]
]
) : [];
) : [];
})() : []
}
)
)
);
);

Revision as of 14:21, 23 May 2017

Task
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.

Translation of: JavaScript
Translation of: Haskell

<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>

  1. include <iostream>
  2. 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.

Translation of: Haskell

<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>

  1. !/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*/

  1. =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
Retrieved from "https://rosettacode.org/wiki/Department_numbers?oldid=275609"