The Computer Language
24.11 Benchmarks Game

fannkuch-redux Haskell GHC program

source code

{-  The Computer Language Benchmarks Game
    https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
    contributed by Miha Vučkovič
-}

import System.Environment
import Control.Applicative

flop (2:x1:t) = x1:2:t
flop (3:x1:x2:t) = x2:x1:3:t
flop (4:x1:x2:x3:t) = x3:x2:x1:4:t
flop (5:x1:x2:x3:x4:t) = x4:x3:x2:x1:5:t
flop (6:x1:x2:x3:x4:x5:t) = x5:x4:x3:x2:x1:6:t
flop (7:x1:x2:x3:x4:x5:x6:t) = x6:x5:x4:x3:x2:x1:7:t

flop lst@(h:_) = r where
	(t, r) = flop' h (lst, t)
	flop' 0 (t, r) = (t, r)
	flop' n ((h:t), r) = flop' (n-1) (t, h:r)

flopS (1:_) = 0
flopS lst = 1 + flopS (flop lst)

rotate n (h:t) = rotate' (n-1) t where
	rotate' 0 l = h:l
	rotate' n (f:t) = f:(rotate' (n-1) t)

checksum i f
   | mod i 2 == 0 = f
   | True = -f

pfold r [] = r
pfold (ac, af) ((c, f):t)  = seq sc $ seq sf $ pfold (sc, sf) t where 
	sc = ac+c
	sf = max af f

permut n = foldr perm [[1..n]] [2..n] where
   perm x lst = concat [take x $ iterate (rotate x) l | l <- lst]

main = do
   n <- read.head <$> getArgs
   let (chksm, mflops) = pfold (0,0) $ map (\(i, p) -> let flops = flopS p in (checksum i flops, flops)) $ zip [0..] (permut n)
   putStrLn $ (show chksm) ++ "\nPfannkuchen(" ++ (show n) ++ ") = " ++ (show $ mflops)
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
The Glorious Glasgow Haskell
Compilation System,
version 9.10.1
LLVM version 18.1.3


 Thu, 01 Aug 2024 18:59:42 GMT

MAKE:
mv fannkuchredux.ghc fannkuchredux.hs
~/.ghcup/bin/ghc --make -fllvm -O2 -XBangPatterns -threaded -rtsopts -XScopedTypeVariables fannkuchredux.hs -o fannkuchredux.ghc_run
Loaded package environment from /home/dunham/.ghc/x86_64-linux-9.10.1/environments/default
[1 of 2] Compiling Main             ( fannkuchredux.hs, fannkuchredux.o )
fannkuchredux.hs:17:1: warning: [GHC-94817] [-Wtabs]
    Tab character found here, and in six further locations.
    Suggested fix: Please use spaces instead.
   |
17 |         (t, r) = flop' h (lst, t)
   | ^^^^^^^^

fannkuchredux.hs:41:14: warning: [GHC-63394] [-Wx-partial]
    In the use of ‘head’
    (imported from Prelude, but defined in GHC.Internal.List):
    "This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use "Data.List.NonEmpty"."
   |
41 |    n <- read.head <$> getArgs
   |              ^^^^

[2 of 2] Linking fannkuchredux.ghc_run
rm fannkuchredux.hs

17.84s to complete and log all make actions

COMMAND LINE:
 ./fannkuchredux.ghc_run +RTS -N4 -RTS 12

PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65