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

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs
View file

@ -1,18 +1,16 @@
import Data.Array
q = qq (listArray (1,2) [1,1]) 1 where
qq ar n = (arr!n) : qq arr (n+1) where
l = snd (bounds ar)
step n =arr!(n - (fromIntegral (arr!(n - 1)))) +
arr!(n - (fromIntegral (arr!(n - 2))))
arr :: Array Int Integer
arr | n <= l = ar
| otherwise = listArray (1, l*2)$
([ar!i | i <- [1..l]] ++
[step i | i <- [l+1..l*2]])
qq ar n = (arr!n) : qq arr (n+1) where
l = snd (bounds ar)
step n =arr!(n - (fromIntegral (arr!(n - 1)))) +
arr!(n - (fromIntegral (arr!(n - 2))))
arr :: Array Int Integer
arr | n <= l = ar
| otherwise = listArray (1, l*2)$
([ar!i | i <- [1..l]] ++
[step i | i <- [l+1..l*2]])
main = do
putStr("first 10: "); print (take 10 q)
putStr("1000-th: "); print (q !! 999)
putStr("flips: ")
print $ length $ filter id $ take 100000 (zipWith (>) q (tail q))
putStr("first 10: "); print (take 10 q)
putStr("1000-th: "); print (q !! 999)
putStr("flips: ")
print $ length $ filter id $ take 100000 (zipWith (>) q (tail q))

27
Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs
View file

@ -2,19 +2,20 @@ import Data.Array
import Data.Int (Int64)
q = qq [listArray (1,2) [1,1]] 1 where
qq a n = seek aa n : qq aa (1 + n) where
aa | n <= l = a
| otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a
where
l = snd (bounds $ head a)
lst = seek a (l-1):seek a l:(ext lst (l+1))
ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i)
g = seek aa
seek (ar:ars) n
| n >= fst (bounds ar) = ar ! n
| otherwise = seek ars n
qq a n = seek aa n : qq aa (1 + n) where
aa | n <= l = a
| otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a
where
l = snd (bounds $ head a)
lst = seek a (l-1):seek a l:(ext lst (l+1))
ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i)
g = seek aa
seek (ar:ars) n
| n >= fst (bounds ar) = ar ! n
| otherwise = seek ars n
-- Only a perf test. Task can be done exactly the same as above
main = print $ sum qqq
where qqq :: [Int64]
qqq = map fromIntegral $ take 3000000 q
where
qqq :: [Int64]
qqq = map fromIntegral $ take 3000000 q