Data.BNum module

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
module Data.BNum where

import Prelude hiding (and, or, not)
import Control.Boolean          -- http://lpaste.net/108295
import Analytics.Theory.Number  -- http://lpaste.net/107480 -- for pow
import Control.Monad            -- for join

{--

A solution to the boolean arithmetic problem posted at http://lpaste.net/108358

The meta language:

Given the operators from yesterday (and, or, not, etc), and only one data type, 
Bool, okay: two data types, you can string the bool values together with 
whatever array-like structure you choose (list, deque, vector, array, pick one).

Define the arithmetic operators: addition, subtraction, multiplication,
exponentiation.

Bonus, define division.

The machine language:

Reduce the arithmetic operators to a set of combinations of a single boolean
operator. How are these arithmetic operators defined? How did you manage carry?

 --}

-- we use the least-significant-bit-first implementation of binary numbers:

data BNum = B [Bool]
   deriving Eq

bzero = B []

-- The approach for add:

-- tt: tt = f, tf = t, ft = t, ff = f           -- xor
-- tt for the carry bit: tt = t, otherwise f    -- and

-- splitter = t = t,t, f = f,f

add :: BNum -> BNum -> BNum
add (B a) (B b) = B $ add' a b False

add' :: [Bool] -> [Bool] -> Bool -> [Bool]
add' (h1:t1) (h2:t2) carry = 
   xor (xor h1 h2) carry : add' t1 t2 (or carry (and h1 h2))
add' [] [] carry = appendCarry [] carry
add' list [] carry = add' list [carry] False
add' [] list carry = add' [carry] list False

appendCarry :: [Bool] -> Bool -> [Bool]
appendCarry list False = list
appendCarry list True  = list ++ [True]

{--

*Main> B $ replicate 6 True
B63
*Main> add it (B [True, True, False])
B66
*Main> B $ replicate 6 True
B63
*Main> add it (B [True, True])
B66
*Main> add (B [True, True]) (B [False, True, True])
B9
*Main> add (B [True, True]) (B [False, True])
B5

Now, add as a set of nand-instructions:

From Control.Boolean:

xor a b = not (equ a b)
   so not = nand True
   so equ a b = or (and a b) (nor a b)
      so or a b = nand (not a) (not b)
      so and a b = not (nand a b)
      so nor a b = not (or a b)

SO:

nand True (nand (nand True a) (nand True b)) 
   where a = and a b
         b = nor a b

SO:

nand True (nand (nand True (nand True (nand a b)))
                (nand True (nand True (nand (nand True a) (nand True b)))))

... and there you have it! YAY!

... um, actually, that's just xor. Let's prove that:

 --}

myxor :: Bool -> Bool -> Bool
myxor a b = nand True (nand (nand True (nand True (nand a b)))
                            (nand True (nand True (nand (nand True a)
                                                  (nand True b)))))

-- yep: testBool myxor == testBool xor ~> True

-- Wow.

-- But you get the point, xor reduces to those nands, then iterate.

mult :: BNum -> BNum -> BNum
mult (B a) (B b) = m' a [] []   -- we take the simple shift-add approach
   where m' [] _ sums = foldr add bzero sums
         m' (bit:rest) shift sums =
            m' rest (False:shift) (if bit then (B (shift ++ b)):sums else sums)

{--

Some multiplies:

*Main> mult (B [True, True]) (B [True, True])
B9
*Main> mult (B [False, False, True]) (B [False, True, True])
B24

 --}

-- a sample circuit that does multiplication is at:
-- https://en.wikipedia.org/wiki/Binary_multiplier

----- and helpful printy-like thingies to see what B-numbers we're working with

instance Num BNum where
   fromInteger x = B $ fromInt x
      where fromInt 0 = []
            fromInt x = let (d, m) = x `divMod` 2
                        in nb m : fromInt d
   a + b = add a b
   a * b = mult a b
   abs a = a
   signum a | toNum a == 0 = 0
            | otherwise    = 1

instance Show BNum where
   show bools = "B" ++ show (toNum bools)

toNum :: BNum -> Integer
toNum (B bools) = t' bools 0
   where t' [] _ = 0
         t' (h : t) n = bn h * pow 2 n + t' t (succ n)

bn :: Bool -> Integer
bn True = 1
bn False = 0

bc :: Bool -> Char
bc True = '1'
bc False = '0'

nb :: Integer -> Bool
nb 0 = False
nb 1 = True

bits :: BNum -> String
bits (B b) = b' b
   where b' [] = []
         b' (h : t) = bc h : b' t

-- Given a set of BNums, scan through each, giving a cross-cutting BNum
-- when one of the BNums is exhausted, returns False thereafter for it

-- you know: your standard matrix transposition problem

transpose :: [BNum] -> [BNum]
transpose [] = []
transpose bnums@(_:_) = t' (map (\(B b) -> b) bnums)
   where t' bs | join bs == [] = []
               | otherwise     = (B (heads bs)) : t' (tails bs)
         -- we need to regularize the data to the longest BNum
         heads [] = []
         heads ([] : t) = False : heads t
         heads ((h:_) : t) = h  : heads t
         tails [] = []
         tails ([] : t) = [] : tails t
         tails ((h:t):rest) = t : tails rest

{--

So:

*Data.BNum> scan [B [False, False, True], B [True, True], B [True]]
[B6,B2,B1]
*Data.BNum> map bits it
["011","010","100"]

 --}
116:48: Warning: Redundant bracket
Found:
(B (shift ++ b)) : sums
Why not:
B (shift ++ b) : sums
146:17: Warning: Use :
Found:
"B" ++ show (toNum bools)
Why not:
'B' : show (toNum bools)
167:10: Error: Use map
Found:
b' [] = []
b' (h : t) = bc h : b' t
Why not:
b' t = map bc t
178:18: Warning: Use null
Found:
join bs == []
Why not:
null (join bs)
179:34: Warning: Redundant bracket
Found:
(B (heads bs)) : t' (tails bs)
Why not:
B (heads bs) : t' (tails bs)