Joseph-Bake

type I = Integer
type M = [I]

g :: (M,I) -> I
g ([],x) = x
g (0:as,x) = f$g (as,x)   where f y = y+1
g (a:as,x) = g (clone l1 (g (as,x))++l2,x)
  where
    (l1,l2) = t$span (a<=) as
    t (lis,[]) = (lis,[])

Joseph-Bake

-- constants

module Consts where

-- 近傍数 nn (自身+その横nnマスをもとに次の世代へ発展させる)
nn :: Integer
nn = 5

-- 状態数 q (セルが取れる状態数)
q :: Integer

Joseph-Bake

-- fish number ver.5
type Flist = [[Integer]]

f5 :: Integer -> Integer
f5 x = m ([replicate (fromInteger x) 1],x)

m :: (Flist,Integer) -> Integer
m (b,x) = mRev (reverse (map (reverse.rm (<0)) b), x)

mRev :: (Flist,Integer) -> Integer

Joseph-Bake

-- multivariable Ackermann function

nAck :: [Integer] -> Integer
nAck [] = 0
nAck x
  | length x == 1                      = head x + 1
  | head x == 0                        = nAck (tail x)
  | last x == 0 && last (init x) >= 1  = nAck (init (init x) ++ [last (init x)-1,1])
  | last x >= 1 && last (init x) >= 1  = nAck (init (init x) ++ [last (init x)-1] ++ [nAck (init x ++ [last x-1])])
  | last x >= 0 && snd (y x) >= 1 && last (fst (y x)) >= 1

Joseph-Bake

type NF = (Integer,Integer -> Integer)
type NFM = (Integer,Integer -> Integer,NF -> NF)

s :: NF -> NF
s (m,f)  =  (g m,g)
  where
    g :: Integer -> Integer
    g n = b n n
    b :: Integer -> Integer -> Integer
    b 0 l = f l

Joseph-Bake

type NF = (Integer,Integer -> Integer)
type NFM = (Integer,Integer -> Integer,NF -> NF)

--S変換
s :: NF -> NF
s (m,f)  =  (g m,g)
  where
    g :: Integer -> Integer
    g n = b n n
    b :: Integer -> Integer -> Integer

Joseph-Bake

-- Beklemishev's worms

worm :: Integer -> [Integer] -> Integer
worm step [] = step
worm step x
  | x == [1]    = 2*step + 3
  | length x >= 2 && drop (length x - 2) x == [0,1]  = worm (from01 step) (init (init x))
  | length x >= 3 && drop (length x - 3) x == [0,1,1]    = worm (from011 (step+2)) (init$init$init x)
  | otherwise   = worm (step+1) (next step x)

Joseph-Bake

-- Beklemishev's worms

worm :: Integer -> [Integer] -> Integer
worm step [] = step
worm step x = worm (step+1) (next step x)

next :: Integer -> [Integer] -> [Integer]
next _ [] = []
next step x
  | last x == 0      = init x

Joseph-Bake

-- n次元 Takeuchi Function
type Tarai = [Int]

main :: IO()
main = print $ length $ ntaraiList initarai

ntarai :: Tarai -> Int
ntarai (a:b:xs)
  | a <= b   = b
  | a >  b   = ntarai (map ntarai (minus1 (krkr (a:b:xs))))

Joseph-Bake

-- Takeuchi Function

import Graphics.Gloss

type Tarai = (Int,Int,Int)

main :: IO()
main =
  animate
    (InWindow "竹内関数可視化" (600,400) (200,200))