No title

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
{--

Solution to @1HaskellADay http://lpaste.net/845208190432837632

Must be reformulated according to @jamestanton tweet:
    The issue is to find 17 consec ints so that each fails to be coprime to
    at least one other integer in the list.
Otherwise it seems to have no solution for 3 consecutive numbers
(try to take 1 $ coComposedSet 3 and it won't end up).

Answer: [2184,2185,2186,2187,2188,2189,2190,2191,2192,2193,
         2194,2195,2196,2197,2198,2199,2200],
        [27830,27831,27832,27833,27834,27835,27836,27837,27838,27839,
         27840,27841,27842,27843,27844,27845,27846],
        ...

Also contains proof that there are no co-composed sets for ranges of numbers
with sizes less than 17.

Inspired by James Tanton's tweet today:

James Tanton ‏@jamestanton 11m11 minutes ago
Find 17 consecutive integers with the property that any two 
of them have a common factor greater than one.

Then a later clarification:

Find 17 consecutive integers such that no one of them has greatest common
factor 1 with each of the remaining 16.

Or, put another way, find n consecutive integers were none
are co-prime.

So, okay, 17 is a big number for me to be thinking about for a 
@1HaskellADay problem, so let's reduce it to something more manageable:

Find 3 integers (a,b,c) where a,b,c are consecutive and all are co-composed,
or a and b are co-composed, a and c are co-composed, and b and c are co-composed

where (denotationally) coComposed x y = gcd x y > 1

(that is, you may choose to define coComposed quite differently, just so
long as coComposedSet meets the requirements on (a,b,c) as specified above.

--}

import Data.List
import Data.Numbers.Primes

coComposedSet :: Integer -> [[Integer]]
coComposedSet s =
    [r | a <- [1 .. ], let r = [a .. a + s - 1], 
     (== s) $ genericLength $ group [x | x <- r, y <- r, y /= x, gcd x y > 1]]

-- get all possible layouts of numbers with common factor m inside
-- an arbitrary contiguous range of s numbers; each layout must contain
-- at least 2 elements
coComposedLayouts :: Int -> Int -> [[Int]]
coComposedLayouts m s =
    filter ((> 1) . length . take 2) $
    map (takeWhile (<= s) . iterate (+ m)) [1 .. m]

-- get union of all possible combinations of numbers with common prime factors
-- 2, 3, 5, 7, 11 and 13 inside an arbitrary contiguous range of s numbers
coComposedPrimeLayouts13 :: Int -> [[Int]]
coComposedPrimeLayouts13 s =
    map (sort . concat)
    [a:b:c:d:e:[f] | a <- coComposedLayouts 2  s, b <- coComposedLayouts 3  s,
                     c <- coComposedLayouts 5  s, d <- coComposedLayouts 7  s,
                     e <- coComposedLayouts 11 s, f <- coComposedLayouts 13 s]

-- test if an arbitrary contiguous range of s numbers may have full co-composed
-- set of numbers, maximum tested prime layout is 13: this is enough for ranges
-- up to 17 numbers
hasCoComposedSet13 :: Int -> Bool
hasCoComposedSet13 s =
    elem s $ map (length . group) $ coComposedPrimeLayouts13 s

main :: IO ()
main = do
    print $ take 2 $ coComposedSet 17
    -- test arbitrary number ranges of sizes 2 .. 17 for possible
    -- co-composed sets
    print $ map hasCoComposedSet13 [2 .. 17]

-- generalized coComposedPrimeLayouts13 with run-time calculation of
-- prime factors, requires import Data.Numbers.Primes
coComposedPrimeLayouts :: Int -> [[Int]]
coComposedPrimeLayouts s =
    map (sort . concat) $ mapM (`coComposedLayouts` s) $ takeWhile (< s) primes

--- same as hasCoComposedSet13 but uses generalized coComposedPrimeLayouts
hasCoComposedSet :: Int -> Bool
hasCoComposedSet s =
    elem s $ map (length . group) $ coComposedPrimeLayouts s