I was taught a different way to calculate exponents using mod and recursion, but I don't fully understand it. The method is: To do b^e, we can break it down like so:
q = e div 2
r = e mod 2
then e = 2q+r, and r could be 0 or 1.
If r=0:
b^e = (b^q)^2
If r=1:
b^e = (b^q)^2 * b
base case: b^0 = 1.
For example: 2^2, b=2, e=2.
q = 2/2 = 1
r = 2mod2 = 0
r=0, therefore 2^2 = 2^1^2
I am trying to code this.
pow :: Integer -> Integer -> Integer
pow b e
| e == 0 = 1
| r == 0 = pow (pow b q) 2
| r == 1 = b * pow (pow b q) 2
where
(q, r) = divMod e 2
But the code does not end any time when e!=0, for example, pow (-2) 4 or pow 1 1 goes on forever. Any idea why?
If you try evaluating pow b 2 by hand you'll quickly see why. Since divMod 2 2 = (1, 0), we expand from pow b 2 to pow (pow b 1) 2. Note that this is also of the form pow b' 2, with b' = pow b 1. So we just get an infinite chain:
pow b 2
=
pow (pow b 1) 2
=
pow (pow (pow b 1) 1) 2
=
pow (pow (pow (pow b 1) 1) 1) 2
=
...
There's a couple ways to solve it. You could add a base case for e == 2, or instead of recursively calling pow twice you could just do the multiplication yourself (as in replacing pow foo 2 with foo * foo in your existing code).
You also need to provide a base case for when e is 2:
pow b 2 = b * b
Without this, your recursion doesn't end, because it becomes pow (pow b 1) 2 and you don't get anywhere.
As mentioned in the previous answers, your code almost works, and it is just a matter of allowing the recursion to stop.
See the code below for a possible fix. The argument of the recursive call is at most half the current argument, hence the recursion will have to stop.
On a side note, this algorithm is more than 2,000 years old, and originated in ancient India. Please treat it with all due respect :-)
https://mathoverflow.net/questions/107708/origin-of-square-and-multiply-algorithm
pow :: Integer -> Integer -> Integer
pow b e
| e == 0 = 1
| r == 0 = let bpq = pow b q in bpq*bpq
| r == 1 = let bpq = pow b q in bpq*bpq*b
where
(q, r) = divMod e 2
main = do
let b = 3 :: Integer
let e = 7 :: Integer
let x = b^e
putStrLn ("b^e = " ++ show x)
let y = pow b e
putStrLn ("pow b e = " ++ show y)
I am doing practice problems that evaluate a let expression and I don't understand the output of this one.
Here is the expression:
let a = 2
b = 1:[i * 2 | i <- b]
f a = 1:[i * a | i <- (f a)]
in take (a+2) (f (head (tail b) ))
The output is supposed to be [1,2,4,8]. Could someone please explain step by step why this is the output
Here's a step-by-step explanation:
let a = 2
b = 1:[i * 2 | i <- b]
f a = 1:[i * a | i <- (f a)]
in take (a+2) (f (head (tail b) ))
There's two different variables called a in there, and one shadows the other, so first let's rename one of them to avoid accidentally mixing them up:
let outer_a = 2
b = 1:[i * 2 | i <- b]
f a = 1:[i * a | i <- (f a)]
in take (outer_a+2) (f (head (tail b) ))
Now we can substitute in outer_a and evaluate the +:
let b = 1:[i * 2 | i <- b]
f a = 1:[i * a | i <- (f a)]
in take 4 (f (head (tail b) ))
Rewrite the list comprehensions in terms of map:
let b = 1:map (* 2) b
f a = 1:map (* a) (f a)
in take 4 (f (head (tail b) ))
Use iterate instead of explicit recursion:
let b = iterate (* 2) 1
f a = iterate (* a) 1
in take 4 (f (head (tail b) ))
Evaluate the first two steps of b:
let b = 1:2:iterate (* 2) 4
f a = iterate (* a) 1
in take 4 (f (head (tail b) ))
Substitute in b:
let f a = iterate (* a) 1
in take 4 (f (head (tail (1:2:iterate (* 2) 4)) ))
Evaluate tail:
let f a = iterate (* a) 1
in take 4 (f (head (2:iterate (* 2) 4) ))
Evaluate head:
let f a = iterate (* a) 1
in take 4 (f 2)
Substitute in f a:
take 4 (iterate (* 2) 1)
Evaluate iterate a few times:
take 4 (1:2:4:8:iterate (* 2) 16)
Evaluate take:
[1,2,4,8]
And we're done.
To see what's going on we carefully name each entity as it comes into being:
let a = 2
b = 1 : [i * 2 | i <- b]
f a = 1 : [i * a | i <- f a]
in take (a+2) (f (head (tail b)))
==
let b = (b1:bs1)
(b1:bs1) = 1 : [i * 2 | i <- b]
in take 4 (f (head (tail b)))
==
let b1 = 1
bs1 = [i * 2 | i <- (b1:bs1)]
in take 4 (f (head bs1))
==
let b1 = 1
bs1 = [i * 2 | i <- [b1]] ++ [i * 2 | i <- bs1]
in take 4 (f (head bs1))
==
let bs1 = [i * 2 | i <- [1]] ++ [i * 2 | i <- bs1]
in take 4 (f (head bs1))
==
let bs1 = (b2:bs2)
(b2:bs2) = [1 * 2] ++ [i * 2 | i <- bs1]
in take 4 (f b2)
==
let (b2:bs2) = 2 : [i * 2 | i <- (b2:bs2)]
in take 4 (f b2)
==
let bs2 = [i * 2 | i <- (2:bs2)]
f a = 1 : [i * a | i <- f a] -- same as before
in take 4 (f 2)
==
let xs = f 2
f 2 = 1 : [i * 2 | i <- f 2]
in take 4 xs
==
let (x1:xs1) = 1 : [i * 2 | i <- f 2]
in take 4 (x1:xs1)
==
let xs1 = [i * 2 | i <- f 2]
in take 4 (1:xs1)
==
let xs1 = [i * 2 | i <- f 2]
in 1 : take 3 xs1
==
let (x2:xs2) = [i * 2 | i <- (y1:ys1)]
(y1:ys1) = 1 : [i * 2 | i <- f 2]
in 1 : take 3 (x2:xs2)
==
let (x2:xs2) = [i * 2 | i <- (1:ys1)]
ys1 = [i * 2 | i <- f 2]
in 1 : take 3 (x2:xs2)
==
let (x2:xs2) = 2 : [i * 2 | i <- ys1]
ys1 = [i * 2 | i <- f 2]
in 1 : take 3 (x2:xs2)
==
let xs2 = [i * 2 | i <- ys1]
ys1 = [i * 2 | i <- f 2]
in 1 : take 3 (2:xs2)
==
let xs2 = [i * 2 | i <- ys1]
ys1 = [i * 2 | i <- f 2]
in 1 : 2 : take 2 xs2
==
let (x3:xs3) = [i * 2 | i <- (y2:ys2)]
(y2:ys2) = [i * 2 | i <- (z1:zs1)]
(z1:zs1) = 1 : [i * 2 | i <- f 2]
in 1 : 2 : take 2 (x3:xs3)
==
let (x3:xs3) = [i * 2 | i <- (y2:ys2)]
(y2:ys2) = 2 : [i * 2 | i <- zs1]
zs1 = [i * 2 | i <- f 2]
in 1 : 2 : take 2 (x3:xs3)
==
let (x3:xs3) = 4 : [i * 2 | i <- ys2]
ys2 = [i * 2 | i <- zs1]
zs1 = [i * 2 | i <- f 2]
in 1 : 2 : take 2 (x3:xs3)
==
let xs3 = [i * 2 | i <- ys2]
ys2 = [i * 2 | i <- zs1]
zs1 = [i * 2 | i <- f 2]
in 1 : 2 : 4 : take 1 xs3
==
let (x4:xs4) = [i * 2 | i <- (y3:ys3)]
(y3:ys3) = [i * 2 | i <- (z2:zs2)]
(z2:zs2) = [i * 2 | i <- (w1:ws1)]
(w1:ws1) = 1 : [i * 2 | i <- f 2]
in 1 : 2 : 4 : take 1 (x4:xs4)
==
let (x4:xs4) = [i * 2 | i <- (y3:ys3)]
(y3:ys3) = [i * 2 | i <- (z2:zs2)]
(z2:zs2) = 2 : [i * 2 | i <- ws1]
ws1 = [i * 2 | i <- f 2]
in 1 : 2 : 4 : take 1 (x4:xs4)
==
let (x4:xs4) = [i * 2 | i <- (y3:ys3)]
(y3:ys3) = 4 : [i * 2 | i <- zs2]
zs2 = [i * 2 | i <- ws1]
ws1 = [i * 2 | i <- f 2]
in 1 : 2 : 4 : take 1 (x4:xs4)
==
let (x4:xs4) = 8 : [i * 2 | i <- ys3]
ys3 = [i * 2 | i <- zs2]
zs2 = [i * 2 | i <- ws1]
ws1 = [i * 2 | i <- f 2]
in 1 : 2 : 4 : take 1 (x4:xs4)
==
1 : 2 : 4 : 8 : take 0 xs4
==
1 : 2 : 4 : 8 : []
In the above derivation we used the property of list comprehensions where
[ ... | ... <- (xs ++ ys)]
===
[ ... | ... <- xs ] ++ [ ... | ... <- ys]
so that
[ ... | ... <- (x : ys)]
===
[ ... | ... <- [x] ] ++ [ ... | ... <- ys]
f a produces the same results as iterate (* a) 1, but operationally it is very much different. While the latter is linear, the former is a quadratic function, w.r.t. its time complexity.
To see what it means in practice, compare the timings for:
> f 1.01 !! 4000
1.9297236994732192e17
(1.28 secs, 1614556912 bytes)
> iterate (* 1.01) 1 !! 4000
1.9297236994732192e17
(0.00 secs, 12990984 bytes)
I'm writing a program on the classification of musical intervals. The conceptual structure is quite complicated and I would represent it as clearly as possible. The first few lines of code are a small extract that works properly. The second are the pseudo-code that would meet my needs of conciseness.
interval pt1 pt2
| gd == 0 && sd < (-2) = ("unison",show (abs sd) ++ "d")
| gd == 0 && sd == (-2) = ("unison","dd")
| gd == 0 && sd == (-1) = ("unison","d")
| gd == 0 && sd == 0 = ("unison","P")
| gd == 0 && sd == 1 = ("unison","A")
| gd == 0 && sd == 2 = ("unison","AA")
| gd == 0 && sd > 2 = ("unison",show sd ++ "A")
| gd == 1 && sd < (-1) = ("second",show (abs sd) ++ "d")
| gd == 1 && sd == (-1) = ("second","dd")
| gd == 1 && sd == 0 = ("second","d")
| gd == 1 && sd == 1 = ("second","m")
| gd == 1 && sd == 2 = ("second","M")
| gd == 1 && sd == 3 = ("second","A")
| gd == 1 && sd == 4 = ("second","AA")
| gd == 1 && sd > 4 = ("second",show (abs sd) ++ "A")
where
(bn1,acc1,oct1) = parsePitch pt1
(bn2,acc2,oct2) = parsePitch pt2
direction = signum sd
sd = displacementInSemitonesOfPitches pt1 pt2
gd = abs $ displacementBetweenTwoBaseNotes direction bn1 bn2
Is there a programming structure that could simplify the code like the following pseudo-code does?
interval pt1 pt2
| gd == 0 | sd < (-2) = ("unison",show (abs sd) ++ "d")
| sd == (-2) = ("unison","dd")
| sd == (-1) = ("unison","d")
| sd == 0 = ("unison","P")
| sd == 1 = ("unison","A")
| sd == 2 = ("unison","AA")
| sd > 2 = ("unison",show sd ++ "A")
| gd == 1 | sd < (-1) = ("second",show (abs sd) ++ "d")
| sd == (-1) = ("second","dd")
| sd == 0 = ("second","d")
| sd == 1 = ("second","m")
| sd == 2 = ("second","M")
| sd == 3 = ("second","A")
| sd == 4 = ("second","AA")
| sd > 4 = ("second",show (abs sd) ++ "A")
| gd == 2 | sd ... = ...
| sd ... = ...
...
| mod gd 7 == 1 | mod sd 12 == ...
| mod sd 12 == ...
...
| otherwise = ...
where
(bn1,acc1,oct1) = parsePitch pt1
(bn2,acc2,oct2) = parsePitch pt2
direction = signum sd
sd = displacementInSemitonesOfPitches pt1 pt2
gd = abs $ displacementBetweenTwoBaseNotes direction bn1 bn2
Thank you in advance for your suggestions.
Let me use a shorter example than the posted one:
original :: Int -> Int
original n
| n < 10 && n > 7 = 1 -- matches 8,9
| n < 12 && n > 5 = 2 -- matches 6,7,10,11
| n < 12 && n > 3 = 3 -- matches 4,5
| n < 13 && n > 0 = 4 -- matches 1,2,3,12
The code runs in GHCi as follows:
> map original [1..12]
[4,4,4,3,3,2,2,1,1,2,2,4]
Our aim is to "group" together the two branches requiring with n < 12, factoring this condition out. (This is not a huge gain in the original toy example, but it could be in more complex cases.)
We could naively think of splitting the code in two nested cases:
wrong1 :: Int -> Int
wrong1 n = case () of
_ | n < 10 && n > 7 -> 1
| n < 12 -> case () of
_ | n > 5 -> 2
| n > 3 -> 3
| n < 13 && n > 0 -> 4
Or, equivalently, using the MultiWayIf extension:
wrong2 :: Int -> Int
wrong2 n = if
| n < 10 && n > 7 -> 1
| n < 12 -> if | n > 5 -> 2
| n > 3 -> 3
| n < 13 && n > 0 -> 4
This however, leads to surprises:
> map wrong1 [1..12]
*** Exception: Non-exhaustive patterns in case
> map wrong2 [1..12]
*** Exception: Non-exhaustive guards in multi-way if
The issue is that when n is 1, the n < 12 branch is taken, the inner case is evaluated, and then no branch there considers 1. The original code simply tries the next branch, which handles it. However, wrong1,wrong2 are not backtracking to the outer case.
Please note that this is not a problem when you know that the outer case has non-overlapping conditions. In the code posted by the OP, this seems to be the case, so the wrong1,wrong2 approaches would work there (as shown by Jefffrey).
However, what about the general case, where there might be overlaps? Fortunately, Haskell is lazy, so it's easy to roll our own control structures. For this, we can exploit the Maybe monad as follows:
correct :: Int -> Int
correct n = fromJust $ msum
[ guard (n < 10 && n > 7) >> return 1
, guard (n < 12) >> msum
[ guard (n > 5) >> return 2
, guard (n > 3) >> return 3 ]
, guard (n < 13 && n > 0) >> return 4 ]
It is a bit more verbose, but not by much. Writing code in this style is easier than it might look: a simple multiway conditional is written as
foo n = fromJust $ msum
[ guard boolean1 >> return value1
, guard boolean2 >> return value2
, ...
]
and, if you want a "nested" case, just replace any of the return value with a msum [ ... ].
Doing this ensures that we get the wanted backtracking. Indeed:
> map correct [1..12]
[4,4,4,3,3,2,2,1,1,2,2,4]
The trick here is that when a guard fails, it generates a Nothing value. The library function msum simply selects the first non-Nothing value in the list. So, even if every element in the inner list is Nothing, the outer msum will consider the next item in the outer list -- backtracking, as wanted.
I'd recommend to group each nested condition in a function:
interval :: _ -> _ -> (String, String)
interval pt1 pt2
| gd == 0 = doSomethingA pt1 pt2
| gd == 1 = doSomethingB pt1 pt2
| gd == 2 = doSomethingC pt1 pt2
...
and then, for example:
doSomethingA :: _ -> _ -> (String, String)
doSomethingA pt1 pt2
| sd < (-2) = ("unison",show (abs sd) ++ "d")
| sd == (-2) = ("unison","dd")
| sd == (-1) = ("unison","d")
| sd == 0 = ("unison","P")
| sd == 1 = ("unison","A")
| sd == 2 = ("unison","AA")
| sd > 2 = ("unison",show sd ++ "A")
where sd = displacementInSemitonesOfPitches pt1 pt2
Alternatively you can use the MultiWayIf language extension:
interval pt1 pt2 =
if | gd == 0 -> if | sd < (-2) -> ("unison",show (abs sd) ++ "d")
| sd == (-2) -> ("unison","dd")
| sd == (-1) -> ("unison","d")
...
| gd == 1 -> if | sd < (-1) -> ("second",show (abs sd) ++ "d")
| sd == (-1) -> ("second","dd")
| sd == 0 -> ("second","d")
...
This isn't really an answer to the title question, but adresses your particular application. Similar approaches will work for many other problems where you might wish for such sub-guards.
First I'd recommend you start out less “stringly typed”:
interval' :: PitchSpec -> PitchSpec -> Interval
data Interval = Unison PureQuality
| Second IntvQuality
| Third IntvQuality
| Fourth PureQuality
| ...
data IntvQuality = Major | Minor | OtherQual IntvDistortion
type PureQuality = Maybe IntvDistortion
data IntvDistortion = Augm Int | Dimin Int -- should actually be Nat rather than Int
And regardless of that, your particular task can be done much more elegantly by “computing” the values, rather than comparing with a bunch of
hard-coded cases. Basically, what you need is this:
type RDegDiatonic = Int
type RDeg12edo = Rational -- we need quarter-tones for neutral thirds etc., which aren't in 12-edo tuning
courseInterval :: RDegDiatonic -> (Interval, RDeg12edo)
courseInterval 0 = ( Unison undefined, 0 )
courseInterval 1 = ( Second undefined, 1.5 )
courseInterval 2 = ( Third undefined, 3.5 )
courseInterval 3 = ( Fourth undefined, 5 )
...
You can then “fill in” those undefined interval qualities by comparing the 12edo-size with the one you've given, using1
class IntervalQuality q where
qualityFrom12edoDiff :: RDeg12edo -> q
instance IntervalQuality PureQuality where
qualityFrom12edoDiff n = case round n of
0 -> Nothing
n' | n'>0 -> Augm n
| otherwise -> Dimin n'
instance IntervalQuality IntvQuality where
qualityFrom12edoDiff n | n > 1 = OtherQual . Augm $ floor n
| n < -1 = OtherQual . Dimin $ ceil n
| n > 0 = Major
| otherwise = Minor
With that, you can implement your function thus:
interval pt1 pt2 = case gd of
0 -> Unison . qualityFrom12edoDiff $ sd - 0
1 -> Second . qualityFrom12edoDiff $ sd - 1.5
2 -> Third . qualityFrom12edoDiff $ sd - 3.5
3 -> Fourth . qualityFrom12edoDiff $ sd - 5
...
1You don't really need a type class here, I could as well have defined two diffently-named functions for pure and other intervals.
this is my code
font a = let x= ord a in
if x>=0 || x<=31 || x>=126 then ["*****","*****","*****","*****","*****","*****","*****"]
else
auxfont (fontBitmap!!(x-32))
where
auxfont b = let y = map trns (map rInt (map show b)) in
convertir y []
trns z = modA [] 1 z
modA o l k
| l < 8 = modA (o++[(k `mod` 2)]) (l+1) (k `div` 2)
| otherwise o
convertir (e1:e2:e3:e4:e5) f
| e1==[] = f
| otherwise convertir [tail(e1),tail(e2),tail(e3),tail(e4),tail(e5)] (f++[(psr(head(e1)))++(psr(head(e2)))++(psr(head(e3)))++(psr(head(e4)))++(psr(head(e5)))])
psr 0 = " "
psr 1 = "*"
and i had and this error in convertir:
[1 of 2] Compiling Pixels ( Pixels.hs, interpreted )
Pixels.hs:122:13: parse error (possibly incorrect indentation)
Failed, modules loaded: none.
Why the error
Every (normal) guard is of the form
| boolean expression = value
You missed this out for your otherwise cases. It works like this because otherwise is defined as
otherwise = True
so it's not a keyword like else, it's just a human-readable "always", and since the guards are tried top-to-bottom, this is a catch-all for anything that wasn't true above.
Some corrections
font a = let x= ord a in
if x>=0 || x<=31 || x>=126 then ["*****","*****","*****","*****","*****","*****","*****"]
else
auxfont (fontBitmap!!(x-32))
where
auxfont b = let y = map trns (map rInt (map show b)) in
convertir y []
trns z = modA [] 1 z
modA o l k
| l < 8 = modA (o++[(k `mod` 2)]) (l+1) (k `div` 2)
here:
| otherwise = o -- added =
convertir (e1:e2:e3:e4:e5) f
| e1==[] = f
and here:
| otherwise = convertir [tail(e1),tail(e2),tail(e3),tail(e4),tail(e5)] (f++[(psr(head(e1)))++(psr(head(e2)))++(psr(head(e3)))++(psr(head(e4)))++(psr(head(e5)))])
psr 0 = " "
psr 1 = "*"
Some abbreviations
By the way,
["*****","*****","*****","*****","*****","*****","*****"] is replicate 7 "*****" and
map trns (map rInt (map show b)) is map (trns.fInt.show) b.
Also [tail(e1),tail(e2),tail(e3),tail(e4)] is map tail [e1,e2,e3,e4,e5]
but I think you have a type error with :e5, because it has to be a list of lists in the pattern (e1:e2:e3:e4:e5) but you've used it like an element tail(e5).
Also [(psr(head(e1)))++(psr(head(e2)))++(psr(head(e3)))++(psr(head(e4)))++(psr(head(e5)))] is map (psr.head) [e1,e2,e3,e4,e5].
Why are these pseudo-Haskell function definitions not accepted?
f n = if n<3 then n else g 2 2 1 0 where
g n a b c = a -- note that 'n' is a value of the enclosing scope
g k a b c = g (k+1) (a+2*b+3*c) a b
which computes this "exercise-function": f(n) = n if n<3 else f(n-1) + 2*f(n-2) + 3*f(n-3)
fib n = let
f n a b = b -- note that 'n' is a value of the enclosing scope
f k a b = f (k+1) b (a+b)
in f 1 0 1
for computing fibonacci numbers. Of course this works:
fib n = let { f k a b = if k==n then b else f (k+1) b (a+b);} in f 1 0 1
But in both the example with where and the one with let, I get
Warning: Pattern match(es) are overlapped
Why can't I define a function-closure using pattern matching with a value that I get from the enclosing scope?
Is that because the value from the enclosing scope is determined (in general) at runtime and for some reason (What reason?) the compiler cannot orchestrate that?
This is a language design choice: pattern matching can't be done on variables. It avoid tricky brain gymnastic to decide whether or not you pattern match against an existing variable or if you declare a local variable. Actually, take a look at this example:
Foo.hs:
module Foo where
foo: Int = 42
Bar.hs:
module Bar where
import Foo
bar :: Int -> Bool
bar foo = True
bar _ = False
You can't easily guess that foo is bound by looking at Bar.hs. Having a syntax where the context is required to decide whether you declare a new variable or use an existing one is misleading.
As a workaround, you can still use guards:
f n = if n<3 then n else g 2 2 1 0 where
g k a _ _ | k == n = a
g k a b c = g (k+1) (a+2*b+3*c) a b
or
f n = if n<3 then n else g 2 2 1 0 where
g k a b c | k == n = a
| otherwise = g (k+1) (a+2*b+3*c) a b