0
\$\begingroup\$

Just started out with CIS 194 on Haskell and wonder what the more idiomatic way to solve this problem would have been.

This code is supposed to generate all possible combinations of 6 given colors up to a given length. It works, but I think my solution is not that elegant. The suggested solution included this hint:

Hint: This exercise is a bit tricky. Try using a helper function that takes in all the codes of length n − 1 and uses it to produce all codes of length n. You may find the concatMap function helpful.

But I could not figure a way so I did it like this:

-- Mastermind -----------------------------------------

-- A peg can be one of six colors
data Peg = Red | Green | Blue | Yellow | Orange | Purple
         deriving (Show, Eq, Ord)

-- A code is defined to simply be a list of Pegs
type Code = [Peg]

-- List containing all of the different Pegs
colors :: [Peg]
colors = [Red, Green, Blue, Yellow, Orange, Purple]

---- Exercise 6 ----

-- Extends a given Code by prepending a Peg: extendCode [Red, Green] Blue -> [Blue, Red, Green]
extendCode :: Code -> Peg -> Code
extendCode code peg = peg : code

-- Extends a given Code by all possible Pegs, turning the Code into a list of Codes
fullyExtendCode :: Code -> [Code]
fullyExtendCode code = map (\color -> extendCode code color) colors

-- Extends a given number of Codes by all possible Pegs
fullyExtendCodes :: [Code] -> [Code]
fullyExtendCodes [] = map (:[]) colors
fullyExtendCodes codes = concatMap fullyExtendCode codes

-- Helper function for allCodes which includes the Codes list from previous recursions
aCodes :: [Code] -> Int -> [Code]
aCodes codes 0 = codes
aCodes codes l = aCodes (fullyExtendCodes codes) (l - 1)

allCodes :: Int -> [[Peg]]
allCodes l = aCodes [] l

Any suggestions from more experiened Haskell programmers?

\$\endgroup\$
  • 1
    \$\begingroup\$ If you've just started, you probably want to add beginner. But that depends on you. \$\endgroup\$ – Zeta Apr 17 '17 at 18:01
2
\$\begingroup\$

You are looking for all of the variations (with repetitions) of a given list!

variations :: Int -> [a] -> [[a]]
variations n cs
 | n <= 0 = []
 | n == 1 = map pure cs --  map (\c -> [c]) cs
 | otherwise = variations (n-1) cs >>= \ps -> map (:ps) cs

Where the right side of the last line could be any of the following:

variations (n-1) cs >>= flip map cs . flip (:)

concatMap (\ps -> map (:ps) cs) (variations (n-1) cs)

concat . map (\ps -> map (\c -> c:ps) cs) $ variations (n-1) cs

Pick your poison. They are all equivalent. as >>= f is the same as concatMap f as, because for the list monad join is concat, and fmap is map, so bind = (>>=) is join . fmap = concat . map.

Let me demonstrate how variations is evaluated for cs = "12", n=2.

Since variations 1 "12" = ["1", "2"], we know that
variations 2 "12" = concat . map (\ps -> map (\c -> c:ps) "12") $ ["1", "2"]
Let's see what each mapping does.

map (\c -> c:ps) "12" simply takes a character c from "12" and appends it to the beginning of ps. But what's ps? Let's look at the other map.

The outer map simply applies the inner function \ps -> map (\c -> c:ps) "12" to each element of ["1","2"]. As we have seen, this inner function simply takes the list cs and maps the element c to c:ps. In this case it turns "1" into ["11","21"], and "2" into ["12","22"].

So all in all we have the following.

variations 2 "12" = concat . map (\ps -> map (\c -> c:ps) "12") $ variations 1 "12"
                  = concat . map (\ps -> map (\c -> c:ps) "12") $ ["1", "2"]
                  = concat [["11","21"],["12","22"]] 
                  = ["11","21","12","22"]

Hope this helps.

\$\endgroup\$
  • \$\begingroup\$ I would use n <= 0 = [[]] and then the second case isn't needed. With that and another output ordering, variations is specialized replicateM. \$\endgroup\$ – Gurkenglas Apr 17 '17 at 15:47
  • \$\begingroup\$ @Gurkenglas That's definitely a valid point. I chose to do it this way, because I thought choosing n=2 makes the "demonstration" a bit more demonstrative, and the n=2 case is easier to follow this way. Thanks for mentioning replicateM, I completely forgot about it. \$\endgroup\$ – Andrew Apr 17 '17 at 17:31
2
\$\begingroup\$

Any suggestions from more experiened Haskell programmers?

I had a quick look at CIS194, and think that you cannot be expected to know the tools that make it a lot shorter yet. One thing that comes to mind is that you can make most of your functions general. None of them need to be for Peg and [Peg], you could use them on any [a], if you didn't use colors throughout your code:

extendCode :: [a] -> a -> [a]
extendCode code peg = peg : code

fullyExtendCode :: [a] -> [a] -> [[a]]
fullyExtendCode colors code = map (extendCode code) colors

fullyExtendCodes :: [a] -> [[a]] -> [[a]]
fullyExtendCodes colors []    = map (:[]) colors 
fullyExtendCodes colors codes = concatMap (fullyExtendCode colors) codes

aCodes :: [a] -> [[a]] -> Int -> [[a]]
aCodes colors codes 0 = codes
aCodes colors codes l = aCodes colors (fullyExtendCodes colors codes) (l - 1)

allCodesG :: Int -> [a] -> [[a]]
allCodesG l colors = aCodes colors [] l

I've kept the variable names, but that gives you an idea. Now allCodesG can be used for any kind of list, regardless of whether it's a color, a taste, or kinds of megalomaniac cybercats.

Note that this is more than the exercise asks for.

That being said, it should be easier, right? Let us have a look at fullyExtendCodes. Now, with it's new type signature, let's rename it to combine:

combine :: [a] -> [[a]] -> [[a]]
combine choices [] = map (:[]) choices
combine choices ys = concatMap (\y -> map (:y) choices)) ys

It's still the same, although now heavily inlined. Exercise: Check whether combine works the same as fullyExtendCodes.

Now we need to combine colors several times. We can generalize something like that:

nTimes :: Int -> (a -> a) -> a -> a
nTimes n f x
  | n <= 0   = x
  |otherwise = nTimes (n - 1) f (f x)

That function was hidden in aCodes by the way. Exercise: How would you have to change aCodes to almost get nTimes? Why?

Now allCodes is just a combination of our previous, rather generic functions:

allCodes :: Int -> [Code]
allCodes n = nTimes n (combine colors) []

Which is the most one could ask you for if you didn't read chapter 7 yet.

Exercises

  • Can you get rid of the first pattern in combine? What do you have to change in allCodes?
  • Write a function allTimes :: (a -> a) -> a -> [a], that generates an infinite list, where allTimes f x = [x, f x, f (f x), …].
  • Lecture 2 mentions (!!), which takes the n-th entry from a list, e.g. [1,2,3] !! 0 == 1. Can you use that to rewrite nTimes with allTimes?
  • There's a function that works like allTimes in Prelude. What is it's name?
  • (*) When you've read chapter 7, rewrite combine as a list comprehension
  • (**) When you've read chapter 8, rewrite combine using its Applicative instance
  • (**) Again, after chapter 7/8: search the standard library for helper functions that work with Monad. Which function can you use for your task to solve it almost immediately?
\$\endgroup\$
  • \$\begingroup\$ Combine works indeed the same as fullyExtendCodes, even tho it took me half an hour to really understand what happens in concatMap (\y -> map (:y) choices) ys. To change aCodes to almost get nTimes I would use guards and switch parameters around and generify the function. aCodes makes a lot of assumptions about the structure of the input and has a fixed function. How could I get rid of the first pattern in combine? concatMap in the normal Case would always map an empty list to [] (unless i use an if..else or guards but that would not count as getting rid of the pattern). \$\endgroup\$ – AdHominem Apr 21 '17 at 9:19
  • \$\begingroup\$ @AdHominem ad combine-pattern: Yes. If you get rid of the first pattern, you end up with combine … [] = []. However, what if you change [] to [[]] in allCodes? ad aCodes: I'm not sure where I was going with that exercise. I think I wanted to go from nTimes to aCodes, e.g. "how can you use nTimes to implement aCodes", but your answer is valid. \$\endgroup\$ – Zeta Apr 21 '17 at 9:28
1
\$\begingroup\$

Well, what we want, is a list of all possible products, right? So, we we want a list of lists of Peg, or a [[Peg]].

Well, our first two cases for Red - Purple are pretty easy.

A list of length 0 lists of Peg is just an empty lists of lists, or [[]].

A list of length 1 lists of lists of Peg is each individual item in our sum type of Peg, in a singleton list. That seems obnoxious to type out, so we'll import transpose from Data.List, and derive an Enum class for Peg, giving us transpose [Red .. Purple] as our answer.

So, so far, we've got:

import Data.List (transpose)

data Peg = Red | Green | Blue | Yellow | Orange | Purple
     deriving (Show, Eq, Ord,Enum)
nCombos n
        | n < 0 = error "Cannot generate negative length list"
        | n ==0 = [[]]
        | n == 1 = transpose [[Red .. Purple]]
        | otherwise = error "I didn't get this far yet."

But now we need every possible combination of length n lists... Well, it just so happens that Haskell gives us a really quick and easy way to generate powersets from component lists, it's called the Applicative typeclass, which has a baked in instance for the [] type.

Lets take a quick break to learn about how that works.

The workhorse of the Applicative typeclass is the (<*>) operator, possessing type: (<*>) :: f (a -> b) -> f a -> f b

So, for lists, it has the following signature: (<*>) :: [a -> b] -> [a] -> [b]

It works like so:

λ>[(+1)] <*> [1,2,3]           
[2,3,4]                        
λ>[(+)] <*> [1,2,3] <*> [1,2,3]
[2,3,4,3,4,5,4,5,6]            

So, as we can see, it applies the (f b) from the right to everything on the left. So this means that we get a powerset of all of the arguments in the chain of (<*>) operators, finally fed into the function on the left.

So, the basic idea us that in [a], [b] and [a->b->c] we can get every possible product of a and b.

Seems like we can leverage that to get us what we need...

For 2 length lists, we'll want to concatenate every length 1 [Peg] with every other other length 1 [Peg].

That's pretty easy to do -

kickIt n = [(++)] <*> (transpose [n]) <*> (transpose [n])
λ>kickIt [Red .. Purple]
[[Red,Red],[Red,Green],[Red,Blue],[Red,Yellow],[Red,Orange],[Red,Purple],[Green,Red],[Green,Green],[Green,Blue],[Green,Yellow],[Green,Orange],[Green,Purple],[Blue,Red],[Blue,Green],[Blue,Blue],[Blue,Yellow],[Blue,Orange],[Blue,Purple],[Yellow,Red],[Yellow,Green],[Yellow,Blue],[Yellow,Yellow],[Yellow,Orange],[Yellow,Purple],[Orange,Red],[Orange,Green],[Orange,Blue],[Orange,Yellow],[Orange,Orange],[Orange,Purple],[Purple,Red],[Purple,Green],[Purple,Blue],[Purple,Yellow],[Purple,Orange],[Purple,Purple]]

But now we need a way to take [[Pegs]] and add all other possible combinations with another set of the [Peg] singletons... Well, so we want to take type [[Peg]] and return type [[Peg]]. That sounds like a job for iterate -

iterate :: (a -> a) -> a -> [a]

There is a neat little haskell idiom for feeding something to itself x times - \f acc n -> (iterate f acc) !! n

Or, generate an infinite list execute f on it's own result, starting with value acc, and give me the nth item.

So, now we use what we know about the applicative operator, and partial application, to build our iterable function ...

 keepRolling l r = ([(++)] <*> transpose [n] <*> r)

And then we put it all together:

import Data.List (transpose)

data Peg = Red | Green | Blue | Yellow | Orange | Purple
     deriving (Show, Eq, Ord,Enum)

kickIt n = [(++)] <*> (transpose [n]) <*> (transpose [n])

keepRolling l r = ([(++)] <*> transpose [n] <*> r)


nCombos n
        | n < 0 = error "Cannot generate negative set"
        | n ==0 = [[]]
        | n == 1 = transpose [[Red .. Purple]]
        | otherwise = iterate (keepRolling [Red .. Purple]) (kickIt [Red .. Purple]) !! (n - 2)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.