Haskell Function-CodePudding

I need to create a function that takes string and decoding rules. It is supposed to change characters in string until there is nothing possible to change according to decoding rules. Each time I get string and decoding rules (first is what change, second is to what).

I'm quite lost, I tried to create all possible combinations and then generate list based on rules. Here's my try.

rules = [('E',"GZ"),('F',"HK"),('C',"EF"),('J',"CC")]
string = "JCEJ"

combinations = [(x,y,z) | x <- [ch | ch <- string], y <- [x | (x,y) <- rules], z <- [y | (x,y) <- rules]]

generate = [z | (x,y,z) <- combinations, if x == y then z else x]

Error message:

decoder.hs:8:57: error:
    • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
    • In the expression: z
      In the expression: if x == y then z else x
      In a stmt of a list comprehension: if x == y then z else x
  |
8 | generate = [z | (x,y,z) <- combinations, if x == y then z else x]
  |                                                         ^

decoder.hs:8:64: error:
    • Couldn't match expected type ‘Bool’ with actual type ‘Char’
    • In the expression: x
      In the expression: if x == y then z else x
      In a stmt of a list comprehension: if x == y then z else x
  |
8 | generate = [z | (x,y,z) <- combinations, if x == y then z else x]
  |                                                                ^

CodePudding user response：

Disclaimer: none of this is as pretty as it could be.

You have a lookup table with rules. Haskell has a handy lookup function:

ghci> :t lookup
lookup :: Eq a => a -> [(a, b)] -> Maybe b

We can fold a lookup over the string:

ghci> foldr (\x i -> case lookup x rules of {Just s -> s    i; _ -> (x:i)}) "" "EF"
"GZHK"

Let's call this singlePassDecode:

singlePassDecode :: Foldable t => t Char -> [(Char, [Char])] -> [Char]
singlePassDecode s rules = foldr update "" s
  where
    update ch acc = 
      case lookup ch rules of
        Just s' -> s'    acc
        Nothing -> ch : ""

But a single pass doesn't necessarily get the job done. We need to recursively call this until there are no transformations left to perform. This means we need to know if any of the characters in the input string are in the lookup table.

The ... is left to fill in with the correct recursive call to avoid presenting a complete answer.

decode :: [Char] -> [(Char, [Char])] -> [Char]
decode s rules
  | any (\ch -> elem ch (map fst rules)) s = ...
  | otherwise = s

The first condition might also be expressed as follows.

any (flip elem $ map fst rules) s

CodePudding user response：

A String is a list of Chars, so the [ch | ch <- string] is not necessary.

You here defined some inner list comprehensions with x, but that x is a more locally scoped variable, not the x as the x in x <- [ ch | ch <- str].

You can make a filter condition to filter, so:

generate = concat [ y | x <- string, (x', y) <- rules, … ]

Here the … is a part that you will need to fill in. It will need to compare x with x'.

CodePudding user response：

Your list of rules describes a mapping from one Char to either two Chars (if there is a match) or one Char (the original input, if there is no match). We can handle both of those cases by always returning a [Char], and we can generalize to any a rather than being specific to Char:

import Data.Maybe (fromMaybe)

transform :: Eq a => [(a, [a])] -> a -> [a]
transform rules x = fromMaybe [x] (lookup x rules)

Since this mapping depends on no other context, concatMap (also spelled (>>=)) is a great tool for applying it across a list of inputs and concatenating the results.

transformAll :: Eq a => [(a, [a])] -> [a] -> [a]
transformAll rules = concatMap (transform rules)
-- or, transformAll = concatMap . transform

It will also be useful to have a function that applies a function repeatedly until it results in no change:

fixPoint :: Eq a => (a -> a) -> a -> a
fixPoint f x | x == x' = x
             | otherwise = fixPoint f x'
  where x' = f x

Then all that's left is to combine our tools:

transformStringRepeatedly :: Eq a => [(a, [a])] -> [a] -> [a]
transformStringRepeatedly rules = fixPoint (transformAll rules)
-- or, transformStringRepeatedly = fixPoint . transformAll

main = print (transformStringRepeatedly [('E',"GZ"),('F',"HK"),('C',"EF"),('J',"CC")] "JCEJ")

We can see that it produces the answer you expected:

$ runghc tmp.hs
"GZHKGZHKGZHKGZGZHKGZHK"