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.
Related
Implement the interval2 :: Int -> Int -> Int -> [Int] function,that lists numbers from the first parameter to the third parameter, the stepping's size is the second parameter. Using [n..m], [n,k..m] or [n..] is prohibited.
For example:
interval2 1 1 10 == [1,2..10]
interval2 10 1 0 == [10,11..0]
interval2 10 (-1) 0 == [10,9..0]
interval2 1 2 10 == [1,3..10]
interval2 10 2 0 == [10,12..0]
interval2 0 (-2) (-10) == [0,(-2)..(-10)]
interval2 1 (-1) 10 == [1,0..10]
interval2 0 (-10) (-1000) == [0,(-10)..(-1000)]
So far, I've managed to write some cases, but they didn't do the job very well.
interval2 x y z | x < z && y > 0 = [x] ++ interval2 (x+y) y z
| x < z && y < 0 = [x] ++ interval2 (x-y) y z
| x > z && y > 0 = [x] ++ interval2 (x-y) y z
| x > z && y < 0 = [x] ++ interval2 (x+y) y z
| x == z || x > z = [z]
There are basically two cases when you should emit a new value:
if x <= z and y > 0; and
if x >= z and y < 0.
In both cases that means the list contains x as first element and should recurse on the interval with x+y. In case none of these conditions are not met, then we have reached the end of the list.
This thus means that the function looks like:
interval2 x y z
| (x <= z && y > 0) || (x >= z && y < 0) = …
| otherwise = …
where I leave implementing … as an exercise.
Naming is important. When learning, naming is very important.
What is x? What is y? What is z? Are all of them the same, conceptually?
No, as the exercise describes it, it is
interval2 :: Int -> Int -> Int -> [Int]
interval2 from stepSize to =
this already gets you half way there towards the solution. Yes it does.
Or actually, you have a contradiction. According to the title of your post, it is
interval2b :: Int -> Int -> Int -> [Int]
interval2b from numSteps to =
But in any case, solving the first one first, you seem to get lost in the multitude of tests. Instead of doing all of them in one function, why not do a test to decide which of several functions to use to do the job; then write each of those functions being already able to assume certain things, namely those which we've tested for:
interval2 from stepSize to
| stepSize > 0 = increasing from
| stepSize < 0 = decreasing from
| otherwise = []
where
increasing from
| from
and now it is easy to see which test to perform here, isn't it?
> to = []
| otherwise = from : increasing ....
decreasing from
| from
and similarly here.
.........
..................
I hope this helps you manage this complexity so you'll be able to complete this code yourself.
Is there a recursion way to do somethings like below?
updateOs2 :: [(Rotor, Int)] -> [(Rotor, Int)]
updateOs2 [(a,x),(b,y),(c,z)]
| x == 25 && y == 25 && z == 25 = [(a,0),(b,0),(c,0)]
| x == 25 && y == 25 = [(a,0),(b,0),(c,z+1)]
| x == 25 = [(a,0),(b,y+1),(c,z)]
| otherwise = [(a,x+1),(b,y),(c,z)]
I have tried to do recursion, but quite confused. Because once the last element z is passed the list comes to empty, can not go back to x anymore.
I think this should work
updateOs2 [] = []
updateOs2 ((a,x):xs)
| x == 25 = (a,0): (updateOs2 xs)
| otherwise = (a,x+1):xs
Code is here , when i call numberOf 3 or numberOf integer>2 im getting this error ERROR - C stack overflow . My code should change numbers between 2^(n-2) (2^n)-1 for n>2 to Binary and check if is there consecutive 0 or not . If is there dont count and if there isnt +1 .
numberOf :: Integer -> Integer
numberOf i = worker i
worker :: Integer -> Integer
worker i
| (abs i) == 0 = 0
| (abs i) == 1 = 2
| (abs i) == 2 = 3
| otherwise = calculat (2^((abs i)-2)) ((2^(abs i))-2)
calculat :: Integer -> Integer -> Integer
calculat ab bis
| ab == bis && (checker(toBin ab)) == True = 1
| ab < bis && (checker(toBin ab)) == True = 1 + (calculat (ab+1) bis)
| otherwise = 0 + (calculat (ab+1) bis)
checker :: [Integer] -> Bool
checker list
| list == [] = True
| 0 == head list && (0 == head(tail list)) = False
| otherwise = checker ( tail list)
toBin :: Integer -> [Integer]
toBin n
| n ==0 = [0]
| n ==1 = [1]
| n `mod` 2 == 0 = toBin (n `div` 2) ++ [0]
| otherwise = toBin (n `div` 2) ++ [1]
Tests :
numberOf 3 Answer:(5)
numberOf 5 (13)
numberOf 10 (144)
numberOf (-5) (13)
The problem lies with your definition of calculat. You have the cases of ab == bis and ab < bis, but the only place you call calculat is from worker with the arguments 2^(abs i - 1) and 2^(abs i - 2). Since the first number (ab) will always be larger than the second (bis), checking for ab < bis is pretty silly. In your otherwise condition you then increment ab, ensuring that this function will never terminate. Did you instead mean otherwise = calculat ab (bis + 1)?
You could also clean your code up substantially, there are many places where you've done things the hard way, or added unnecessary clutter:
-- Remove worker, having it separate from numberOf was pointless
numberOf :: Integer -> Integer
numberOf i
| i' == 0 = 0
| i' == 1 = 2
| i' == 2 = 3
-- Lots of unneeded parentheses
| otherwise = calculat (2 ^ (i' - 1)) (2 ^ i' - 2)
-- Avoid writing the same expression over and over again
-- define a local name for `abs i`
where i' = abs i
calculat :: Integer -> Integer -> Integer
calculat ab bis
-- Remove unneeded parens
-- Don't need to compare a boolean to True, just use it already
| ab == bis && checker (toBin ab) = 1
| ab < bis && checker (toBin ab) = 1 + calculat (ab + 1) bis
-- 0 + something == something, don't perform unnecessary operations
| otherwise = calculat (ab + 1) bis
-- Pattern matching in this function cleans it up a lot and prevents
-- errors from calling head on an empty list
checker :: [Integer] -> Bool
checker [] = True
checker (0:0:_) = False
checker (_:xs) = checker xs
-- Again, pattern matching can clean things up, and I find an in-line
-- if statement to be more expressive than a guard.
toBin :: Integer -> [Integer]
toBin 0 = [0]
toBin 1 = [1]
toBin n = toBin (n `div` 2) ++ (if even n then [0] else [1])
In calculat in case ab == bis but checker returns false you cant return from the function.
How about:
| ab >= bis && (checker(toBin ab)) == True = 1
| ab < bis && (checker(toBin ab)) == True = 1 + (calculat (ab+1) bis)
| otherwise = 0 + (calculat (ab+1) bis)
| ab >= bis = 0
| ab < bis == True = 0 + (calculat (ab+1) bis)
| otherwise = 0 + (calculat (ab+1) bis)
I've been playing with Haskell and writing some code to parse DICOM medical images. The code is here. I wanted to create a function that will take in a ByteString and return a name. So a certain ByteString (actually two Int64s taken from a ByteString) would return PatientName or StudyDate for example. There are thousands of these and they are all contained within an XML file. So to create the function I parse the XML file and generate the desired function and output to a file using
writeTagNameFromElemGroup :: FilePath -> [(String,String,String,String)] -> IO()
writeTagNameFromElemGroup fp tups = init >> Prelude.appendFile fp ( Prelude.drop 0 tags )
where init = Prelude.appendFile fp "\ntagNameFromElem :: Element -> Group -> String\ntagNameFromElem e g\n"
tags = LS.concat $ Prelude.map (\tup -> " | " ++ (writeTup tup) ++ "\n") filTups
hexInt x = show . readHex $ x
filTups = LS.filter (\(w,x,y,z) -> Prelude.length w == 4 && Prelude.length x ==4 ) tups
This creates the desired function in Tags.hs
tagNameFromElem :: Int64 -> Int64 -> String
tagNameFromElem e g
| e == 8 && g == 1 = "LengthToEnd"
| e == 8 && g == 5 = "SpecificCharacterSet"
| e == 8 && g == 6 = "LanguageCodeSequence"
| e == 8 && g == 8 = "ImageType"
| e == 8 && g == 16 = "RecognitionCode"
| e == 8 && g == 18 = "InstanceCreationDate"
| e == 8 && g == 19 = "InstanceCreationTime"
| e == 8 && g == 20 = "InstanceCreatorUID"
| e == 8 && g == 22 = "SOPClassUID"
| e == 8 && g == 24 = "SOPInstanceUID"
| e == 8 && g == 26 = "RelatedGeneralSOPClassUID"
| e == 8 && g == 27 = "OriginalSpecializedSOPClassUID"
..... > 2000 more
Every so often there is a special case like
| e == 1000 && mod (g -5) 10 == 0 = "ShiftTableTriplet"
which put me off just using a map.
Now this approach works but it takes a very long time to load (Over a minute) the whole which makes me think that I'm not doing this how it should be done. To reproduce I suggest cloning the repo and loading the Tags.hs.
A SSCE
writeFunc :: (Num x, Show x) => FilePath -> [x] -> IO()
writeFunc fp xs = init >> Prelude.appendFile fp ( maps ) >> Prelude.appendFile fp "| otherwise = 0 "
where init = Prelude.appendFile fp "mapVal :: Int -> Int \nmapVal x\n "
maps = concat $ Prelude.map (\x -> "| x == " ++ show x ++ " = " ++ show (x +1 ) ++ "\n ") xs
Use a long list ~ few thousand values and try to import the resulting file
This answer is based on what bheklilr suggested in the question's comments. Code generation is up to you.
I reviewed your code and found that there are only two values in which e imposes special conditions on g: e == 28 and e == 1000. So, it'd be better to handle those in separate functions. Choose better names than the following ones, please.
e28 :: Map Int64 String
e28 = fromList [ (0, "CodeLabel"), (2, "NumberOfTables"), ... ]
e1000 :: Map Int64 String
e1000 :: fromList [ (0, "EscapeTriplet"), (1, "RunLengthTriplet"), ... ]
The keys of the previous maps are taken from your special-case predicate: mod (g - key) 10 == 0.
The case where e == 1010 is also special, since it doesn't depend on g. It's always "ZonalMap", so it'll be dealt with later.
Now, just create the rest of maps using g as key.
e40 :: Map Int64 String
e40 = fromList [ (2, "SamplesPerPixel"), (3, "SamplesPerPixelUsed"), ... ]
e84 :: Map Int64 String
e84 = fromList [ ... ]
...
Create a map from regular es (i.e. not the 28, 1000 or 1010 ones) to their corresponding map:
regularE :: Map Int64 (Map Int64 String)
regularE e = fromList [ (40, e40), (84, e84), ... ]
To sum it all up:
import Control.Monad
tagNameFromElem :: Int64 -> Int64 -> Maybe String
tagNameFromElem 28 g = lookup e28 (mod g 10)
tagNameFromElem 1000 g = lookup e1000 (mod g 10)
tagNameFromElem 1010 _ = Just "ZonalMap"
tagNameFromElem e g = lookup regularE e >>= (`lookup` g)
The lookup function is from Data.Map, just in case qualification is required. Using Maybe handles the case where e or g do not map to a valid tag name, instead of a hardcoded "Not Found" string.
Note that I haven't tested this code; I'm not at home right now.
If you want, try IntMap instead of Map. You'll need to work with regular Ints in this case, but it may be good for this project.
I have some problems with the different types in Haskell, how can I solve this?
Couldn't match expected type Integer with actual type Int -> t0 -> t0
Thanks
isPrime :: Int -> Bool
isPrime number
| (number == 1) || (number == 2) = True
| even number = False
| otherwise = checkDiv number (fromInteger (`sqrt` number))
checkDiv :: Int -> Int -> Bool
checkDiv number divisor
| number == 2 = True
| (floor number `mod` divisor) == 0 = False
| otherwise = checkDiv number $ divisor - 1
I've figured out the modifications to get the code to compile, but it does not actually find primes. I had to change
fromInteger (`sqrt` number)
to
floor $ sqrt $ fromIntegral number
The backtick notation around a function name is to turn it in to an infix "operator" of sorts, so you could do
mod x y
or
x `mod` y
but not
`mod` x y
Next, you were using fromInteger instead of fromIntegral, which is the one that works on Ints (Int and Integer are different types). Finally, I removed the floor from number in the second guard of checkDiv, since number is already an Int.
isPrime :: Int -> Bool
isPrime number
| (number == 1) || (number == 2) = True
| even number = False
| otherwise = checkDiv number (floor $ sqrt $ fromIntegral number)
checkDiv :: Int -> Int -> Bool
checkDiv number divisor
| number == 2 = True
| (number `mod` divisor) == 0 = False
| otherwise = checkDiv number $ divisor - 1
So let's work through your code so that you can see what's going on. If I were to compute checkDiv 17 4 (4 is floor $ sqrt $ fromIntegral 17), it would perform
checkDiv 17 4
| 17 == 2 No
| 17 `mod` 4 == 0 No
| otherwise = checkDiv 17 (4 - 1) = checkDiv 17 3
checkDiv 17 3
| 17 == 2 No
| 17 `mod` 3 == 0 No
| otherwise = checkDiv 17 (3 - 1) = checkDiv 17 2
checkDiv 17 2
| 17 == 2 No
| 17 `mod` 2 == 0 No
| otherwise = checkDiv 17 (2 - 1) = checkDiv 17 1
checkDiv 17 1
| 17 == 2 No
| 17 `mod` 1 == 0 Yes = False
But 17 is prime! Do you see where your algorithm is doing something wrong?