Sheldon's Theorem

Sheldon.hs

-- [Sheldon's (Conjecture) Theorem](https://www.math.dartmouth.edu/~carlp/sheldonresub011119.pdf)
import Test.QuickCheck
import Data.Tuple
import Data.List

unDigits base = foldl (\a b -> a * base + b) 0

digitsRev base = unfoldr step
  where
    step 0 = Nothing
    step n = Just $ swap (divMod n base)

primes = sieve [2..] where sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p /= 0]

index = zip [1..]

sheldon (n,p) = isProduct && isMirror
  where
    isProduct = n == product (r10 p)
    isMirror  = rev p == primes !! (rev n - 1)
    rev = unDigits 10 . r10
    r10 = digitsRev 10

isPrimeSheldon x = x == snd p && sheldon p
  where
    p = head $ dropWhile ((x>).snd) (index primes)

sheldonPrimes = map snd $ filter sheldon (index primes)

test = head sheldonPrimes == 73

prop_Sheldon :: Positive Int -> Property
prop_Sheldon (Positive x) = classify (x == 73) "= 73" $
    (x == 73) === (isPrimeSheldon x)

main = quickCheck $ withMaxSuccess 100000 prop_Sheldon

Proof of Sheldon's Conjecture