aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

37
Task/Sexy-primes/Haskell/sexy-primes-1.hs Normal file
View file

@ -0,0 +1,37 @@
import Text.Printf (printf)
import Data.Numbers.Primes (isPrime, primes)
type Pair = (Int, Int)
type Triplet = (Int, Int, Int)
type Quad = (Int, Int, Int, Int)
type Quin = (Int, Int, Int, Int, Int)
type Result = ([Pair], [Triplet], [Quad], [Quin], [Int])
groups :: Int -> Result -> Result
groups n r@(p, t, q, qn, u)
| isPrime n4 && isPrime n3 && isPrime n2 && isPrime n1 = (addPair, addTriplet, addQuad, addQuin, u)
| isPrime n3 && isPrime n2 && isPrime n1 = (addPair, addTriplet, addQuad, qn, u)
| isPrime n2 && isPrime n1 = (addPair, addTriplet, q, qn, u)
| isPrime n1 = (addPair, t, q, qn, u)
| not (isPrime (n+6)) && not (isPrime n1) = (p, t, q, qn, n : u)
| otherwise = r
where addPair = (n1, n) : p
addTriplet = (n2, n1, n) : t
addQuad = (n3, n2, n1, n) : q
addQuin = (n4, n3, n2, n1, n) : qn
n1 = n - 6
n2 = n - 12
n3 = n - 18
n4 = n - 24
main :: IO ()
main = do
printf ("Number of sexy prime pairs: %d\n" <> lastFiveText) (length pairs) (lastFive pairs)
printf ("Number of sexy prime triplets: %d\n" <> lastFiveText) (length triplets) (lastFive triplets)
printf ("Number of sexy prime quadruplets: %d\n" <> lastFiveText) (length quads) (lastFive quads)
printf "Number of sexy prime quintuplets: %d\n Last 1 : %s\n\n" (length quins) (show $ last quins)
printf "Number of unsexy primes: %d\n Last 10: %s\n\n" (length unsexy) (show $ drop (length unsexy - 10) unsexy)
where (pairs, triplets, quads, quins, unsexy) = foldr groups ([], [], [], [], []) $ takeWhile (< 1000035) primes
lastFive xs = show $ drop (length xs - 5) xs
lastFiveText = " Last 5 : %s\n\n"

50
Task/Sexy-primes/Haskell/sexy-primes-2.hs Normal file
View file

@ -0,0 +1,50 @@
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens (makeLenses, over, (^.), to, view)
import Data.Numbers.Primes (isPrime, primes)
import Text.Printf (printf)
data Group a = Group { _count :: Int, _results :: [a] } deriving (Show)
makeLenses ''Group
type Groups = ( Group (Int, Int)
, Group (Int, Int, Int)
, Group (Int, Int, Int, Int)
, Group (Int, Int, Int, Int, Int)
, Group Int )
initialGroups :: Groups
initialGroups = let newGroup = Group 0 []
in (newGroup, newGroup, newGroup, newGroup, newGroup)
collect :: Groups -> Int -> Groups
collect r@(pr, tt, qd, qn, un) n
| isPrime n4 && isPrime n3 && isPrime n2 && isPrime n1 = (addPair pr, addTriplet tt, addQuad qd, addQuin qn, un)
| isPrime n3 && isPrime n2 && isPrime n1 = (addPair pr, addTriplet tt, addQuad qd, qn, un)
| isPrime n2 && isPrime n1 = (addPair pr, addTriplet tt, qd, qn, un)
| isPrime n1 = (addPair pr, tt, qd, qn, un)
| not (isPrime (n+6)) && not (isPrime n1) = (pr, tt, qd, qn, addUnSexy un)
| otherwise = r
where
n1 = n-6
n2 = n-12
n3 = n-18
n4 = n-24
addPair = over count succ . over results (take 5 . (:) (n1, n))
addTriplet = over count succ . over results (take 5 . (:) (n2, n1, n))
addQuad = over count succ . over results (take 5 . (:) (n3, n2, n1, n))
addQuin = over count succ . over results (take 1 . (:) (n4, n3, n2, n1, n))
addUnSexy = over count succ . over results (take 10 . (:) n)
main :: IO ()
main = do
let (pr, tt, qd, qn, un) = collectGroups primes
printf "Number of sexy prime pairs: %d\n Last 5 : %s\n\n" (pr ^. count) (pr ^. results . to display)
printf "Number of sexy prime triplets: %d\n Last 5 : %s\n\n" (tt ^. count) (tt ^. results . to display)
printf "Number of sexy prime quadruplets: %d\n Last 5 : %s\n\n" (qd ^. count) (qd ^. results . to display)
printf "Number of sexy prime quintuplets: %d\n Last 1 : %s\n\n" (qn ^. count) (qn ^. results . to display)
printf "Number of unsexy primes: %d\n Last 10: %s\n\n" (un ^. count) (un ^. results . to display)
where
collectGroups = foldl collect initialGroups . takeWhile (< 1000035)
display :: Show a => [a] -> String
display = show . reverse