Related
In this program , I wanted to ask the user about number of cards and draw that number of cards from a deck (see below) and tell the user the cards and the
"total" of those cards. In this case, I mean a blackjack count of up to 21, with
counts over 21 returning Nothing. A blackjack count counts 2-10 as its face value, jacks,
queens and kings count as 10 and aces count as 1 or 11. I need two functions:
drawHand :: Int ->Deck ->([Card],Deck) and totalCards :: [Card] ->Maybe Int
import Data.List
import Data.Random
drawHand :: Int -> Deck -> ([Card], Deck)
totalCards :: [Card] -> Maybe Int
main = do
putStrLn "How many cards?"
Random :: MonadRandom m => Deck-> m Deck
Random ran = runRVar (shuffle deck) StdRandom
Random <- getLine
putStrLn "Hand of [] totalCards: " ++ totalCards
error:
Failed to load interface for ‘Data.Random’
Perhaps you meant Data.Ratio (from base-4.9.0.0)
Use -v to see a list of the files searched for.
PLEASE HELP ME
At this point we have no information about the Card and Deck data types.
However, it seems that the problem at hand is to randomly extract M cards from an initial deck of N cards.
If this interpretation of the question is correct, we can thus use the Rand monad constructor, and start by defining a monadic action that transfers just one card from the right deck to the left deck.
As we have no information about the types in use, we will assume that the “cards” are denoted by plain numbers, from 0 to 51.
Next, we define an action moving M cards recursively, moving one card and then calling ourselves with an (M-1) argument. For M=0, we define the action as a no-op.
This would be the monadic code:
import System.Random
import Control.Monad.Random
moveOneCardLeft :: RandomGen g => ([a],[a]) -> Rand g ([a],[a])
moveOneCardLeft (deck, rest) =
do
let remCount = length rest
choice <- getRandomR (0, (remCount-1))
let (top, bot) = splitAt choice rest
return $ ((head bot) : deck, top ++ (tail bot))
moveSomeCardsLeft :: RandomGen g => Int -> ([a],[a]) -> Rand g ([a],[a])
moveSomeCardsLeft 0 (deck, rest) = return (deck, rest) -- unchanged
moveSomeCardsLeft n (deck, rest) =
do
(deck1, rest1) <- moveOneCardLeft (deck, rest)
(deck2, rest2) <- moveSomeCardsLeft (n-1) (deck1, rest1)
return (deck2, rest2)
extractSomeCards :: RandomGen g => Int -> [a] -> Rand g ([a], [a])
extractSomeCards n xs =
do
(deck, rest) <- moveSomeCardsLeft n ([], xs)
return (deck, rest)
Next, the pure code and some tentative game-related utility functions:
drawSomeCards :: RandomGen g => g -> Int -> [a] -> (([a], [a]), g)
drawSomeCards gen0 n xs = runRand (extractSomeCards n xs) gen0
cardValue :: Int -> Int
cardValue n = let rank = mod n 13
in if (rank < 10) then (rank+1)
else {- Jack Queen King -} 10
deckValue :: [Int] -> Int
deckValue cards = sum (map cardValue cards)
totalOfCards :: [Int] -> Maybe Int
totalOfCards cards =
let s = deckValue cards
in if (s <= 21) then (Just s) else Nothing
Finally, the user test code:
main = do
let wholeDeck = [0..51]
randomSeed = 4243
gen0 = mkStdGen randomSeed
putStrLn "How many cards ?"
inLine <- getLine
let count = (read inLine :: Int)
putStrLn $ "Want to extract " ++ (show count) ++ " cards."
let ((deck, rest), gen1) = drawSomeCards gen0 count wholeDeck
sumw = sum wholeDeck
suma = sum deck
sumb = sum rest
sum0 = (suma + sumb) - sumw
putStrLn $ "Must be zero: " ++ (show sum0) -- sanity check
putStrLn $ "deck: " ++ (show deck)
putStrLn $ "rest: " ++ (show rest)
putStrLn $ "Deck value: " ++ (show $ deckValue deck)
Program execution:
$ q67025780.x
How many cards ?
10
Want to extract 10 cards.
Must be zero: 0
deck: [8,47,38,49,4,31,9,30,28,23]
rest: [0,1,2,3,5,6,7,10,11,12,13,14,15,16,17,18,19,20,21,22,24,25,26,27,29,32,33,34,35,36,37,39,40,41,42,43,44,45,46,48,50,51]
Deck value: 77
$
Note: if deemed appropriate, the above code beyond moveOneCardLeft can be simplified using the nest :: Monad m => Int -> (a -> m a) -> a -> m a function from the Control.Monad.HT package.
Like this:
import Control.Monad.HT (nest)
moveOneCardLeft :: RandomGen g => ([a],[a]) -> Rand g ([a],[a])
moveOneCardLeft (deck, rest) =
do
let remCount = length rest
choice <- getRandomR (0, (remCount-1))
let (top, bot) = splitAt choice rest
return $ ((head bot) : deck, top ++ (tail bot))
drawSomeCards :: RandomGen g => g -> Int -> [a] -> (([a], [a]), g)
drawSomeCards gen0 n xs = let action = nest n moveOneCardLeft ([], xs)
in runRand action gen0
In pure functional languages like Haskell, is there an algorithm to get the inverse of a function, (edit) when it is bijective? And is there a specific way to program your function so it is?
In some cases, yes! There's a beautiful paper called Bidirectionalization for Free! which discusses a few cases -- when your function is sufficiently polymorphic -- where it is possible, completely automatically to derive an inverse function. (It also discusses what makes the problem hard when the functions are not polymorphic.)
What you get out in the case your function is invertible is the inverse (with a spurious input); in other cases, you get a function which tries to "merge" an old input value and a new output value.
No, it's not possible in general.
Proof: consider bijective functions of type
type F = [Bit] -> [Bit]
with
data Bit = B0 | B1
Assume we have an inverter inv :: F -> F such that inv f . f ≡ id. Say we have tested it for the function f = id, by confirming that
inv f (repeat B0) -> (B0 : ls)
Since this first B0 in the output must have come after some finite time, we have an upper bound n on both the depth to which inv had actually evaluated our test input to obtain this result, as well as the number of times it can have called f. Define now a family of functions
g j (B1 : B0 : ... (n+j times) ... B0 : ls)
= B0 : ... (n+j times) ... B0 : B1 : ls
g j (B0 : ... (n+j times) ... B0 : B1 : ls)
= B1 : B0 : ... (n+j times) ... B0 : ls
g j l = l
Clearly, for all 0<j≤n, g j is a bijection, in fact self-inverse. So we should be able to confirm
inv (g j) (replicate (n+j) B0 ++ B1 : repeat B0) -> (B1 : ls)
but to fulfill this, inv (g j) would have needed to either
evaluate g j (B1 : repeat B0) to a depth of n+j > n
evaluate head $ g j l for at least n different lists matching replicate (n+j) B0 ++ B1 : ls
Up to that point, at least one of the g j is indistinguishable from f, and since inv f hadn't done either of these evaluations, inv could not possibly have told it apart – short of doing some runtime-measurements on its own, which is only possible in the IO Monad.
⬜
You can look it up on wikipedia, it's called Reversible Computing.
In general you can't do it though and none of the functional languages have that option. For example:
f :: a -> Int
f _ = 1
This function does not have an inverse.
Not in most functional languages, but in logic programming or relational programming, most functions you define are in fact not functions but "relations", and these can be used in both directions. See for example prolog or kanren.
Tasks like this are almost always undecidable. You can have a solution for some specific functions, but not in general.
Here, you cannot even recognize which functions have an inverse. Quoting Barendregt, H. P. The Lambda Calculus: Its Syntax and Semantics. North Holland, Amsterdam (1984):
A set of lambda-terms is nontrivial if it is neither the empty nor the full set. If A and B are two nontrivial, disjoint sets of lambda-terms closed under (beta) equality, then A and B are recursively inseparable.
Let's take A to be the set of lambda terms that represent invertible functions and B the rest. Both are non-empty and closed under beta equality. So it's not possible to decide whether a function is invertible or not.
(This applies to the untyped lambda calculus. TBH I don't know if the argument can be directly adapted to a typed lambda calculus when we know the type of a function that we want to invert. But I'm pretty sure it will be similar.)
If you can enumerate the domain of the function and can compare elements of the range for equality, you can - in a rather straightforward way. By enumerate I mean having a list of all the elements available. I'll stick to Haskell, since I don't know Ocaml (or even how to capitalise it properly ;-)
What you want to do is run through the elements of the domain and see if they're equal to the element of the range you're trying to invert, and take the first one that works:
inv :: Eq b => [a] -> (a -> b) -> (b -> a)
inv domain f b = head [ a | a <- domain, f a == b ]
Since you've stated that f is a bijection, there's bound to be one and only one such element. The trick, of course, is to ensure that your enumeration of the domain actually reaches all the elements in a finite time. If you're trying to invert a bijection from Integer to Integer, using [0,1 ..] ++ [-1,-2 ..] won't work as you'll never get to the negative numbers. Concretely, inv ([0,1 ..] ++ [-1,-2 ..]) (+1) (-3) will never yield a value.
However, 0 : concatMap (\x -> [x,-x]) [1..] will work, as this runs through the integers in the following order [0,1,-1,2,-2,3,-3, and so on]. Indeed inv (0 : concatMap (\x -> [x,-x]) [1..]) (+1) (-3) promptly returns -4!
The Control.Monad.Omega package can help you run through lists of tuples etcetera in a good way; I'm sure there's more packages like that - but I don't know them.
Of course, this approach is rather low-brow and brute-force, not to mention ugly and inefficient! So I'll end with a few remarks on the last part of your question, on how to 'write' bijections. The type system of Haskell isn't up to proving that a function is a bijection - you really want something like Agda for that - but it is willing to trust you.
(Warning: untested code follows)
So can you define a datatype of Bijection s between types a and b:
data Bi a b = Bi {
apply :: a -> b,
invert :: b -> a
}
along with as many constants (where you can say 'I know they're bijections!') as you like, such as:
notBi :: Bi Bool Bool
notBi = Bi not not
add1Bi :: Bi Integer Integer
add1Bi = Bi (+1) (subtract 1)
and a couple of smart combinators, such as:
idBi :: Bi a a
idBi = Bi id id
invertBi :: Bi a b -> Bi b a
invertBi (Bi a i) = (Bi i a)
composeBi :: Bi a b -> Bi b c -> Bi a c
composeBi (Bi a1 i1) (Bi a2 i2) = Bi (a2 . a1) (i1 . i2)
mapBi :: Bi a b -> Bi [a] [b]
mapBi (Bi a i) = Bi (map a) (map i)
bruteForceBi :: Eq b => [a] -> (a -> b) -> Bi a b
bruteForceBi domain f = Bi f (inv domain f)
I think you could then do invert (mapBi add1Bi) [1,5,6] and get [0,4,5]. If you pick your combinators in a smart way, I think the number of times you'll have to write a Bi constant by hand could be quite limited.
After all, if you know a function is a bijection, you'll hopefully have a proof-sketch of that fact in your head, which the Curry-Howard isomorphism should be able to turn into a program :-)
I've recently been dealing with issues like this, and no, I'd say that (a) it's not difficult in many case, but (b) it's not efficient at all.
Basically, suppose you have f :: a -> b, and that f is indeed a bjiection. You can compute the inverse f' :: b -> a in a really dumb way:
import Data.List
-- | Class for types whose values are recursively enumerable.
class Enumerable a where
-- | Produce the list of all values of type #a#.
enumerate :: [a]
-- | Note, this is only guaranteed to terminate if #f# is a bijection!
invert :: (Enumerable a, Eq b) => (a -> b) -> b -> Maybe a
invert f b = find (\a -> f a == b) enumerate
If f is a bijection and enumerate truly produces all values of a, then you will eventually hit an a such that f a == b.
Types that have a Bounded and an Enum instance can be trivially made RecursivelyEnumerable. Pairs of Enumerable types can also be made Enumerable:
instance (Enumerable a, Enumerable b) => Enumerable (a, b) where
enumerate = crossWith (,) enumerate enumerate
crossWith :: (a -> b -> c) -> [a] -> [b] -> [c]
crossWith f _ [] = []
crossWith f [] _ = []
crossWith f (x0:xs) (y0:ys) =
f x0 y0 : interleave (map (f x0) ys)
(interleave (map (flip f y0) xs)
(crossWith f xs ys))
interleave :: [a] -> [a] -> [a]
interleave xs [] = xs
interleave [] ys = []
interleave (x:xs) ys = x : interleave ys xs
Same goes for disjunctions of Enumerable types:
instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where
enumerate = enumerateEither enumerate enumerate
enumerateEither :: [a] -> [b] -> [Either a b]
enumerateEither [] ys = map Right ys
enumerateEither xs [] = map Left xs
enumerateEither (x:xs) (y:ys) = Left x : Right y : enumerateEither xs ys
The fact that we can do this both for (,) and Either probably means that we can do it for any algebraic data type.
Not every function has an inverse. If you limit the discussion to one-to-one functions, the ability to invert an arbitrary function grants the ability to crack any cryptosystem. We kind of have to hope this isn't feasible, even in theory!
In some cases, it is possible to find the inverse of a bijective function by converting it into a symbolic representation. Based on this example, I wrote this Haskell program to find inverses of some simple polynomial functions:
bijective_function x = x*2+1
main = do
print $ bijective_function 3
print $ inverse_function bijective_function (bijective_function 3)
data Expr = X | Const Double |
Plus Expr Expr | Subtract Expr Expr | Mult Expr Expr | Div Expr Expr |
Negate Expr | Inverse Expr |
Exp Expr | Log Expr | Sin Expr | Atanh Expr | Sinh Expr | Acosh Expr | Cosh Expr | Tan Expr | Cos Expr |Asinh Expr|Atan Expr|Acos Expr|Asin Expr|Abs Expr|Signum Expr|Integer
deriving (Show, Eq)
instance Num Expr where
(+) = Plus
(-) = Subtract
(*) = Mult
abs = Abs
signum = Signum
negate = Negate
fromInteger a = Const $ fromIntegral a
instance Fractional Expr where
recip = Inverse
fromRational a = Const $ realToFrac a
(/) = Div
instance Floating Expr where
pi = Const pi
exp = Exp
log = Log
sin = Sin
atanh = Atanh
sinh = Sinh
cosh = Cosh
acosh = Acosh
cos = Cos
tan = Tan
asin = Asin
acos = Acos
atan = Atan
asinh = Asinh
fromFunction f = f X
toFunction :: Expr -> (Double -> Double)
toFunction X = \x -> x
toFunction (Negate a) = \a -> (negate a)
toFunction (Const a) = const a
toFunction (Plus a b) = \x -> (toFunction a x) + (toFunction b x)
toFunction (Subtract a b) = \x -> (toFunction a x) - (toFunction b x)
toFunction (Mult a b) = \x -> (toFunction a x) * (toFunction b x)
toFunction (Div a b) = \x -> (toFunction a x) / (toFunction b x)
with_function func x = toFunction $ func $ fromFunction x
simplify X = X
simplify (Div (Const a) (Const b)) = Const (a/b)
simplify (Mult (Const a) (Const b)) | a == 0 || b == 0 = 0 | otherwise = Const (a*b)
simplify (Negate (Negate a)) = simplify a
simplify (Subtract a b) = simplify ( Plus (simplify a) (Negate (simplify b)) )
simplify (Div a b) | a == b = Const 1.0 | otherwise = simplify (Div (simplify a) (simplify b))
simplify (Mult a b) = simplify (Mult (simplify a) (simplify b))
simplify (Const a) = Const a
simplify (Plus (Const a) (Const b)) = Const (a+b)
simplify (Plus a (Const b)) = simplify (Plus (Const b) (simplify a))
simplify (Plus (Mult (Const a) X) (Mult (Const b) X)) = (simplify (Mult (Const (a+b)) X))
simplify (Plus (Const a) b) = simplify (Plus (simplify b) (Const a))
simplify (Plus X a) = simplify (Plus (Mult 1 X) (simplify a))
simplify (Plus a X) = simplify (Plus (Mult 1 X) (simplify a))
simplify (Plus a b) = (simplify (Plus (simplify a) (simplify b)))
simplify a = a
inverse X = X
inverse (Const a) = simplify (Const a)
inverse (Mult (Const a) (Const b)) = Const (a * b)
inverse (Mult (Const a) X) = (Div X (Const a))
inverse (Plus X (Const a)) = (Subtract X (Const a))
inverse (Negate x) = Negate (inverse x)
inverse a = inverse (simplify a)
inverse_function x = with_function inverse x
This example only works with arithmetic expressions, but it could probably be generalized to work with lists as well. There are also several implementations of computer algebra systems in Haskell that may be used to find the inverse of a bijective function.
No, not all functions even have inverses. For instance, what would the inverse of this function be?
f x = 1
Let's say that we have a function truthtable ::BoolExpr -> [([Variable], Bool)] that returns the value in List of ordered pairs of the variable and it's Bool evaluation.
functions are defined as following
module BoolExpr (Variable, BoolExpr(..), evaluate) where
import Data.List
import System.IO
type Variable = Char
data BoolExpr = T
|F
|Var Variable
|Not BoolExpr
|And BoolExpr BoolExpr
|Or BoolExpr BoolExpr
deriving(Show)
-- evaluates an expression
evaluate :: BoolExpr -> [Variable] -> Bool
evaluate T _ = True
evaluate F _ = False
evaluate (Var v) vs = v `elem` vs
evaluate (Not e) vs = not (evaluate e vs)
evaluate (And e1 e2) vs = evaluate e1 vs && evaluate e2 vs
evaluate (Or e1 e2) vs = evaluate e1 vs || evaluate e2 vs
--remove duplicates
rmdups :: (Ord a) => [a] -> [a]
rmdups = map head . group . sort
variables :: BoolExpr -> [Variable]
variables T = []
variables F = []
variables (Var e1) = [e1]
variables (And e1 e2) =rmdups$ sort $ variables e1 ++ variables e2
variables (Or e1 e2) =rmdups$ sort $ variables e1 ++ variables e2
variables (Not e) = variables e
--function to get the subsets of a list
subsets :: [Variable] -> [[Variable]]
subsets [] = [[]]
subsets (x:xs) = [zs | ys <- subsets xs, zs <- [ys, (x:ys)]]
Now the function subsets return all possible subsets in a string
eg.
> subsets "abc"
["","c","b","bc","a","ac","ab","abc"]
Now how to take each element in this list and put it here
evaluate (And (Var 'a') (Or (Var 'c') (Var 'b'))) "HERE"
I know how to do something like this in C using iteration over the list and doing the calculation.
My approach : number of subsets of string= 2^n, where n is the number of elements
now I would use a scenario like this:
let x=0
iterate form x to (n-1) (subsets $ variables (And e1 e2)) !! x
i know that !! operator allow to pick element from the list according to the index written.
Finally the result of the chunk above is applied to the evaluate function at the end part HERE. that what the function truthtable evaluate as a whole
> truthtable (And (Var 'a') (Or (Var 'c') (Var 'b')))
[("",False),("c",False),("b",False),("bc",False),("a",False),("ac",True),("ab",True),("abc",True)]
any ideas how to apply this in Haskell
Now how to take each element in this list and put it here
evaluate (And (Var 'a') (Or (Var 'c') (Var 'b'))) "HERE"
Like this:
map (evaluate (And ...)) (subsets "abc")
> truthtable (And (Var 'a') (Or (Var 'c') (Var 'b')))
[("",False),("c",False),("b",False), ...
You mean,
truthtable expr =
[ evaluate expr s | s <- subsets (variables expr) ]
{-
expr :: BoolExpr
variables :: BoolExpr -> [Variable]
variables expr :: [Variable]
subsets :: [Variable] -> [[Variable]]
subsets (variables expr) :: [[Variable]]
s :: [Variable]
evaluate :: BoolExpr -> [Variable] -> Bool
evaluate expr s :: Bool
[evaluate expr s ] :: [Bool]
-----------------------------------------------------------------------
truthtable :: BoolExpr -> [Bool]
-}
The [ foo | x <- xs ] syntax is known as "list comprehension".
It is analogous to a loop in imperative paradigm, and can be read as "the list of foos, for x in xs". It is also equivalent to map (\ x -> foo ) xs; also
[ foo | x <- [a, b, c] ]
=
[ foo | x <- [a] ++ [b] ++ [c] ]
=
[ foo | x <- [a] ] ++ [ foo | x <- [b] ] ++ [ foo | x <- [c] ]
=
[ foo | let x=a ] ++ [ foo | let x=b ] ++ [ foo | let x=c ]
:: means "has type".
I am inferring a function using z3py as follows
f = Function('f',IntSort(),IntSort(),IntSort())
After asserting a set of constraints like:
s.add(f(a1,b1)==c1)
s.add(f(a2,b2)==c2)
s.add(f(a3,b3)==c3)...
The function is inferred as
[(a1,b1) -> c1,
(a2,b2) -> c2,
(a3,b3) -> c3,
...,
else -> 2]
How could I constraint the "else" value to a fixed number? So that the output of inferred f will be
[(a1,b1) -> c1,
(a2,b2) -> c2,
(a3,b3) -> c3,
...,
else -> some number that I assert]
Edit:
from z3 import *
s = Solver()
k = Int('k')
f = Function('f',IntSort(),IntSort())
s.add(And(f(1)==1,f(2)==2))
list1 = []
list1.append(k!=1)
list1.append(k!=2)
s.add(ForAll(k,Implies(And(list1),f(k)==5)))
print s.check()
print s.model()
The output is
sat
[f = [1 -> 1, 2 -> 2, else -> 5]]
This seems to work fine for this simple case.
However, when the input for function 'f' in the constraints is undecided. The output can be weird. For example
from z3 import *
s = Solver()
f = Function('f',IntSort(),IntSort(),IntSort())
i = Int('i')
j = Int('j')
k = Int('k')
l = Int('l')
s.add(i>=0,i<5)
s.add(j>=0,j<5)
s.add(And(f(j,1)==i,f(i,2)==j))
list1 = []
list1.append(And(k==1,l==j))
list1.append(And(k==2,l==i))
s.add(ForAll([k,l],Implies(Not(Or(list1)),f(l,k)==5)))
print s.check()
print s.model()
The output is
[i = 0,
k!6 = 0,
j = 3,
k!12 = 6,
f = [else -> f!15(k!13(Var(0)), k!14(Var(1)))],
f!15 = [(3, 1) -> 0, (0, 2) -> 3, else -> 5],
k!13 = [0 -> 0, 3 -> 3, else -> 6],
k!14 = [2 -> 2, 1 -> 1, else -> 0]]
Then it is hard to interpret the inferred f.
It is a great question and very informed analysis. Yes, you can control the default values by using quantifiers. Z3 will have no choice but agree.
However, the encoding of models is based on how the quantifier instantiation engine (see Complete quantifier instantiation by Yeting Ge and Leonardo de Moura).
Z3 does not beta-reduce the expressions in the models and has left it to applications to perform the beta-reduction, if desired. You can have Z3 beta reduce else branches by plugging in your arguments to the parameters of the functions (use the substitution routines exposed by the API), and then call the model evaluator to reduce the resulting expression with respect to the model.
I'm a noob in Haskell, but some experience with ActionScript 3.0 Object Orientated. Thus working on a major programming transition. I've read the basic knowledge about Haskel, like arithmetics. And I can write simple functions.
As a practical assignment I have to generate the Thue-Morse sequence called tms1 by computer in Haskell. So it should be like this:
>tms1 0
0
>tms1 1
1
>tms1 2
10
>tms1 3
1001
>tms1 4
10010110
and so on... According to wikipedia I should use the formula.
t0 = 0
t2n = tn
t2n + 1 = 1 − tn
I have no idea how I can implement this formula in Haskell. Can you guide me to create one?
This is what I got so far:
module ThueMorse where
tms1 :: Int -> Int
tms1 0 = 0
tms1 1 = 1
tms1 2 = 10
tms1 3 = 1001
tms1 x = tms1 ((x-1)) --if x = 4 the output will be 1001, i don't know how to make this in a recursion function
I did some research on the internet and found this code.
Source:
http://pastebin.com/Humyf6Kp
Code:
module ThueMorse where
tms1 :: [Int]
tms1 = buildtms1 [0] 1
where buildtms1 x n
|(n `rem` 2 == 0) = buildtms1 (x++[(x !! (n `div` 2))]) (n+1)
|(n `rem` 2 == 1) = buildtms1 (x++[1- (x !! ((n-1) `div` 2))]) (n+1)
custinv [] = []
custinv x = (1-head x):(custinv (tail x))
tms3 :: [Int]
tms3 = buildtms3 [0] 1
where buildtms3 x n = buildtms3 (x++(custinv x)) (n*2)
intToBinary :: Int -> [Bool]
intToBinary n | (n==0) = []
| (n `rem` 2 ==0) = intToBinary (n `div` 2) ++ [False]
| (n `rem` 2 ==1) = intToBinary (n `div` 2) ++ [True]
amountTrue :: [Bool] -> Int
amountTrue [] = 0
amountTrue (x:xs) | (x==True) = 1+amountTrue(xs)
| (x==False) = amountTrue(xs)
tms4 :: [Int]
tms4= buildtms4 0
where buildtms4 n
|(amountTrue (intToBinary n) `rem` 2 ==0) = 0:(buildtms4 (n+1))
|(amountTrue (intToBinary n) `rem` 2 ==1) = 1:(buildtms4 (n+1))
But this code doesn't give the desired result. Any help is well appreciated.
I would suggest using a list of booleans for your code; then you don't need to explicitly convert the numbers. I use the sequence defined like this:
0
01
0110
01101001
0110100110010110
01101001100101101001011001101001
...
Notice that the leading zeros are quite important!
A recursive definition is now easy:
morse = [False] : map step morse where step a = a ++ map not a
This works because we never access an element that is not yet defined. Printing the list is left as an excercise to the reader.
Here is another definition, using the fact that one can get the next step by replacing 1 with 10 and 0 with 01:
morse = [False] : map (concatMap step) morse where step x = [x,not x]
Edit
Here are easier definitions by sdcvvc using the function iterate. iterate f x returns a list of repeated applications of f to x, starting with no application:
iterate f x = [x,f x,f (f x),f (f (f x)),...]
And here are the definitions:
morse = iterate (\a -> a ++ map not a) [False]
morse = iterate (>>= \x -> [x,not x]) [False]
Your definition of the sequence seems to be as a sequence of bit sequences:
0 1 10 1001 10010110 ... etc.
t0 t1 t2 t3 t4
but the wikipedia page defines it as a single bit sequence:
0 1 1 0 1 ... etc
t0 t1 t2 t3 t4
This is the formulation that the definitions in Wikipedia refer to. With this knowledge, the definition of the recurrence relation that you mentioned is easier to understand:
t0 = 0
t2n = tn
t2n + 1 = 1 − tn
In English, this can be stated as:
The zeroth bit is zero.
For an even, non-zero index, the bit is the same as the bit at half the index.
For an odd index, the bit is 1 minus the bit at half the (index minus one).
The tricky part is going from subscripts 2n and 2n+1 to odd and even, and understanding what n means in each case. Once that is done, it is straightforward to write a function that computes the *n*th bit of the sequence:
lookupMorse :: Int -> Int
lookupMorse 0 = 0;
lookupMorse n | even n = lookupMorse (div n 2)
| otherwise = 1 - lookupMorse (div (n-1) 2)
If you want the whole sequence, map lookupMorse over the non-negative integers:
morse :: [Int]
morse = map lookupMorse [0..]
This is the infinite Thue-Morse sequence. To show it, take a few of them, turn them into strings, and concatenate the resulting sequence:
>concatMap show $ take 10 morse
"0110100110"
Finally, if you want to use the "sequence of bit sequences" definition, you need to first drop some bits from the sequence, and then take some. The number to drop is the same as the number to take, except for the zero-index case:
lookupMorseAlternate :: Int -> [Int]
lookupMorseAlternate 0 = take 1 morse
lookupMorseAlternate n = take len $ drop len morse
where
len = 2 ^ (n-1)
This gives rise to the alternative sequence definition:
morseAlternate :: [[Int]]
morseAlternate = map lookupMorseAlternate [0..]
which you can use like this:
>concatMap show $ lookupMorseAlternate 4
"10010110"
>map (concatMap show) $ take 5 morseAlternate
["0", "1", "10", "1001", "10010110"]
Easy like this:
invertList :: [Integer] -> [Integer]
invertList [] = []
invertList (h:t)
|h == 1 = 0:invertList t
|h == 0 = 1:invertList t
|otherwise = error "Wrong Parameters: Should be 0 or 1"
thueMorse :: Integer -> [Integer]
thueMorse 1 = [0]
thueMorse n = thueMorse (n - 1) ++ invertList (thueMorse (n - 1))