[Snark] [GHC Haskell] data ℕ = Ø | I𐊛 ℕ deriving Eq
Tim Makarios
submissions at badcode.rocks
Fri Jun 7 00:23:30 UTC 2019
Please find attached my submission for this month's bad code
competition. It compiles with GHC on Debian Stretch.
I'm pretty sure that the tests will pass if you let them run long
enough, but it seems it'll take hours on any of my computers (all a
decade old or more, except the server, which I didn't want to slow down
with bad code), and I don't want to miss the deadline.
Incidentally, if you apply the speed-patch, it runs much faster, and I
have no idea why. Even (^), which doesn't involve division in any
possible execution path, runs immensely faster with that patch. But in
the spirit of the bad code competition, I submitted the slow version.
== License ==
-- This deliberately bad code by Tim Makarios is released under the CC0 public
-- domain declaration. All rights conferred under the Plant Variety Rights Act
-- 1987 are reserved.
== Ρascal's ▲.hs ==
{- LANGUAGE GADTs
, Arrows
, FlexibleContexts
, OverloadedStrings
, RankNTypes
, PolymorphicComponents
-}
module Main where
import Control.Monad
import Data.List hiding (replicate)
import Prelude hiding ((+), (-), (/), (^), (<), read, replicate)
import System.Environment
-- Since this exercise involves only natural numbers, we can get the compiler
-- to ensure that we don't accidentally use any negative numbers by defining a
-- type for the natural numbers.
--data ℕ = Ø | I𐊛 ℕ deriving Eq
-- Unfortunately, GHC seems incapable of compiling the elegant simplicity of
-- unary into efficient machine code, and the test require the program to output
-- a near-infinite number of rows of the triangle,so we have to do some of the
-- compiler's work for it by coming up with a representation that better suits
-- the machine. To give the compiler a chance to produce something that will
-- run efficiently on IOTA's Jinn processor, we could use a form of ternary. In
-- particular, in order to get a unique representation for each natural number,
-- let's use bijective ternary.
data ℕ = Ø | I𐊛IIIх ℕ | II𐊛IIIх ℕ | III𐊛IIIх ℕ deriving Eq
--i = I𐊛 Ø
--ii = I𐊛 i
--iii = I𐊛 ii
--iiii = I𐊛 iii
--iiiii = I𐊛 iiii
--iiiiii = I𐊛 iiiii
--iiiiiii = I𐊛 iiiiii
--iiiiiiii = I𐊛 iiiiiii
--iiiiiiiii = I𐊛 iiiiiiii
--iiiiiiiiii = I𐊛 iiiiiiiii
i = I𐊛IIIх Ø
ii = II𐊛IIIх Ø
iii = III𐊛IIIх Ø
iiii = I𐊛IIIх i
iiiii = II𐊛IIIх i
iiiiii = III𐊛IIIх i
iiiiiii = I𐊛IIIх ii
iiiiiiii = II𐊛IIIх ii
iiiiiiiii = III𐊛IIIх ii
iiiiiiiiii = I𐊛IIIх iii
infixl 6 +
n + Ø = n
--n + (I𐊛 m) = I𐊛 (n + m)
(I𐊛IIIх n) + (I𐊛IIIх m) = II𐊛IIIх (n + m)
(II𐊛IIIх n) + (I𐊛IIIх m) = III𐊛IIIх (n + m)
(III𐊛IIIх n) + (I𐊛IIIх m) = I𐊛IIIх (n + m + i)
(II𐊛IIIх n) + (II𐊛IIIх m) = I𐊛IIIх (n + m + i)
(III𐊛IIIх n) + (II𐊛IIIх m) = II𐊛IIIх (n + m + i)
(III𐊛IIIх n) + (III𐊛IIIх m) = III𐊛IIIх (n + m + i)
n + m = m + n
infixl 6 -
n - Ø = n
--(I𐊛 n) - (I𐊛 m) = n - m
(I𐊛IIIх n) - (I𐊛IIIх m) = if n == m then Ø else III𐊛IIIх (n - m - i)
(II𐊛IIIх n) - (I𐊛IIIх m) = I𐊛IIIх (n - m)
(III𐊛IIIх n) - (I𐊛IIIх m) = II𐊛IIIх (n - m)
(I𐊛IIIх n) - (II𐊛IIIх m) = II𐊛IIIх (n - m - i)
(II𐊛IIIх n) - (II𐊛IIIх m) = if n == m then Ø else III𐊛IIIх (n - m - i)
(III𐊛IIIх n) - (II𐊛IIIх m) = I𐊛IIIх (n - m)
(I𐊛IIIх n) - (III𐊛IIIх m) = I𐊛IIIх (n - m - i)
(II𐊛IIIх n) - (III𐊛IIIх m) = II𐊛IIIх (n - m - i)
(III𐊛IIIх n) - (III𐊛IIIх m) = if n == m then Ø else III𐊛IIIх (n - m - i)
iiх n = n + n
--iiiх n = n + iiх n
iiiх n = I𐊛IIIх n - i
infixl 7 ⨉
n ⨉ Ø = Ø
--n ⨉ (I𐊛 m) = n + (n ⨉ m)
{-
n ⨉ (I𐊛IIIх m) = iiiх (n ⨉ m) + n
n ⨉ (II𐊛IIIх m) = iiiх (n ⨉ m) + iiх n
n ⨉ (III𐊛IIIх m) = iiiх (n ⨉ m + n)
-}
(I𐊛IIIх n) ⨉ (I𐊛IIIх m) = I𐊛IIIх (iiiх (n ⨉ m) + n + m)
(II𐊛IIIх n) ⨉ (I𐊛IIIх m) = II𐊛IIIх (iiiх (n ⨉ m) + n + m + m)
(III𐊛IIIх n) ⨉ (I𐊛IIIх m) = III𐊛IIIх (iiiх (n ⨉ m + m) + n)
(II𐊛IIIх n) ⨉ (II𐊛IIIх m) = I𐊛IIIх (iiiх (n ⨉ m) + n + n + m + m + i)
(III𐊛IIIх n) ⨉ (II𐊛IIIх m) = III𐊛IIIх (iiiх (n ⨉ m + m) + n + n + i)
(III𐊛IIIх n) ⨉ (III𐊛IIIх m) = III𐊛IIIх (iiiх (n ⨉ m + n + m) + ii)
n ⨉ m = m ⨉ n
infix 4 <
--Ø < (I𐊛 n) = True
--(I𐊛 n) < (I𐊛 m) = n < m
_ < Ø = False
Ø < _ = True
(I𐊛IIIх n) < (I𐊛IIIх m) = n < m
(II𐊛IIIх n) < (I𐊛IIIх m) = n < m
(III𐊛IIIх n) < (I𐊛IIIх m) = n < m
(I𐊛IIIх n) < (II𐊛IIIх m) = n < m || n == m
(II𐊛IIIх n) < (II𐊛IIIх m) = n < m
(III𐊛IIIх n) < (II𐊛IIIх m) = n < m
(I𐊛IIIх n) < (III𐊛IIIх m) = n < m || n == m
(II𐊛IIIх n) < (III𐊛IIIх m) = n < m || n == m
(III𐊛IIIх n) < (III𐊛IIIх m) = n < m
--_ < _ = False
infixl 7 /
--n / m = if n < m then Ø else I𐊛 ((n - m) / m)
Ø / n = Ø
{-
n / (I𐊛IIIх Ø) = n
(I𐊛IIIх Ø) / _ = Ø
(II𐊛IIIх Ø) / (II𐊛IIIх Ø) = i
(II𐊛IIIх Ø) / _ = Ø
(III𐊛IIIх Ø) / (II𐊛IIIх Ø) = i
(III𐊛IIIх Ø) / (III𐊛IIIх Ø) = i
(III𐊛IIIх Ø) / _ = Ø
(n@(I𐊛IIIх n')) / m = if n < m then Ø else if n < iiх m then i else if n < iiiх m
then ii else if n == iiiх m then iii
else iiiх (n' / m) + I𐊛IIIх (n' `modulo` m) / m
(n@(II𐊛IIIх n')) / m = if n < m then Ø else if n < iiх m then i else if n < iiiх m
then ii else if n == iiiх m then iii
else iiiх (n' / m) + II𐊛IIIх (n' `modulo` m) / m
(n@(III𐊛IIIх n')) / m = if n < m then Ø else if n < iiх m then i else if n < iiiх m
then ii else if n == iiiх m then iii
else iiiх (n' / m) + III𐊛IIIх (n' `modulo` m) / m
-}
(n@(I𐊛IIIх n')) / m = let q' = n' / m in
if q' == Ø
then if n < m then Ø else i + (n - m) / m
else iiiх q' + I𐊛IIIх (n' `modulo` m) / m
(n@(II𐊛IIIх n')) / m = let q' = n' / m in
if q' == Ø
then if n < m then Ø else i + (n - m) / m
else iiiх q' + II𐊛IIIх (n' `modulo` m) / m
(n@(III𐊛IIIх n')) / m = let q' = n' / m in
if q' == Ø
then if n < m then Ø else i + (n - m) / m
else iiiх q' + III𐊛IIIх (n' `modulo` m) / m
infixl 7 `modulo`
--n `modulo` m = if n < m then n else (n - m) `modulo` m
n `modulo` m = n - n / m ⨉ m
infixl 8 ^
n ^ Ø = i
--n ^ (I𐊛 m) = n ⨉ (n ^ m)
n ^ (III𐊛IIIх Ø) = n ⨉ n ⨉ n
n ^ (I𐊛IIIх m) = n ^ m ^ iii ⨉ n
n ^ (II𐊛IIIх m) = n ^ m ^ iii ⨉ n ⨉ n
n ^ (III𐊛IIIх m) = (n ^ m ⨉ n) ^ iii
readDigit '0' = Ø
readDigit '1' = i
readDigit '2' = ii
readDigit '3' = iii
readDigit '4' = iiii
readDigit '5' = iiiii
readDigit '6' = iiiiii
readDigit '7' = iiiiiii
readDigit '8' = iiiiiiii
readDigit '9' = iiiiiiiii
read [] = Ø
read ds = iiiiiiiiii ⨉ read (init ds) + readDigit (last ds)
write Ø = "0"
write (I𐊛IIIх Ø) = "1"
write (II𐊛IIIх Ø) = "2"
write (III𐊛IIIх Ø) = "3"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø)))) = "4"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø))))) = "5"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø)))))) = "6"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø))))))) = "7"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø)))))))) = "8"
--write (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 (I𐊛 Ø))))))))) = "9"
--write (I𐊛 Ø) = "1"
--write (I𐊛 (I𐊛 Ø)) = "2"
--write (I𐊛 (I𐊛 (I𐊛 Ø))) = "3"
write (I𐊛IIIх (I𐊛IIIх Ø)) = "4"
write (II𐊛IIIх (I𐊛IIIх Ø)) = "5"
write (III𐊛IIIх (I𐊛IIIх Ø)) = "6"
write (I𐊛IIIх (II𐊛IIIх Ø)) = "7"
write (II𐊛IIIх (II𐊛IIIх Ø)) = "8"
write (III𐊛IIIх (II𐊛IIIх Ø)) = "9"
write n = write (n / iiiiiiiiii) ++ write (n `modulo` iiiiiiiiii)
--instance Show ℕ where show = write
listLessThan Ø = []
--listLessThan (I𐊛 n) = Ø : (map I𐊛 $ listLessThan n)
listLessThan n = Ø : (map (i +) $ listLessThan $ n - i)
replicate Ø x = []
--replicate (I𐊛 n) x = x : replicate n x
replicate n x = x : replicate (n - i) x
main = do
[textn] <- getArgs
let n = read textn
forM_ (listLessThan n) $ \m -> do
putStrLn
-- The exercise doesn't specify the spacing around the triangle,
-- except via the tests. I believe the following is equivalent to
-- the simplest implementation that will pass all the tests, which
-- was obviously the exercise designer's intention; see [1].
$ replicate (n - m - if iiiii < n && m < iiiii then Ø else i) ' '
++ (concat
$ intersperse " "
$ map (write . \n ->
(ii ^ m + ii) ^ m / (ii ^ m + i) ^ n
-- `modulo` (ii ^ m + i)) $ listLessThan $ I𐊛 m
`modulo` (ii ^ m + i)) $ listLessThan $ i + m
)
++ if n == iiiiii && m == Ø then " " else ""
-- References
-- 1. Vitányi, Paul M. B. and Ming Li; Minimum Description Length Induction,
-- Bayesianism, and Kolmogorov Complexity; CoRR 1999.
More information about the Snark
mailing list