Print all possible world configurations - haskell

Just starting out with Haskell! As an exercise, the current problem I'm trying to implement is as follows:
We have n squares, print all possible world configurations where :
(1) Each square could have a "P" (pit) or not (2^n possibilities).
(2) There can be at most one "W" (wumpus) in all n squares (n+1 possibilities).
Representing two squares as two strings, here is an output example for n=2. We have (2^n)·(n+1) = (2^2)·(2+1) = 12 configurations.
[[" W"," "],[" "," W"],[" "," "],
[" W","P"],[" ","PW"],[" ","P"],
["PW"," "],["P"," W"],["P"," "],
["PW","P"],["P","PW"],["P","P"]]
Condition (1) is easily implemented. Looking around, I've found a few ways to express it :
p 0 = [[]]
p n = [x:xs | x <- [" ","P"], xs <- p (n-1)]
or
p n = mapM (\x -> [" ","P"]) [1..n]
or
p n = replicateM n [" ","P"]
I cannot claim to understand the last two yet, but here they are for completeness.
Question : How can I add condition (2)? Can it be done with list comprehension?
My not-so-good-looking novice solution involved these functions:
insertw :: Int -> [String] -> [String]
insertw n xs
| n < 0 = xs
| n >= lgth = xs
| otherwise = (take (n) xs) ++ [xs!!n++"W"] ++ (drop (n+1) xs)
where lgth = length xs
duplicate :: Int -> [String] -> [[String]]
duplicate i squares
| i > lgth = []
| otherwise = (insertw i squares) : duplicate (i+1) squares
where lgth = length squares
worlds :: Int -> [[String]]
worlds n = concat . map (duplicate 0) . p $ n

Condition 2 isn't an obvious candidate for a list comprehension, but the working code you have already written can be cleaned up.
The iteration from 0 to lgth in duplicate can be done with a map instead of explicit recursion:
duplicate squares = map (\i -> insertw i squares) [0 .. length squares]
duplicate no longer takes an index parameter, and concat . map is the same as concatMap:
worlds = concatMap duplicate . p
If you do both a drop and a take, then splitAt is often the better operation.
insertw n xs =
case splitAt n xs of
(as, []) -> as
(as, b : bs) -> as ++ ((b ++ "W") : bs)
Note that we got rid of the length xs and xs !! n operations too.
As an exercise, another short duplicate function can be written by zipping over the inits and tails of the squares list.

Seems obvious to me :). In list comprehensions, the later lists can depend on the values generated in the earlier ones. The second function generates your set by calling the first when it adds a wumpus..
p 0 = [[]]
p n = [[x,' ']:xs | x <- [' ','P'], xs <- p (n-1)]
pw 0 = [[]]
pw n = [[x,w]:xs | w <- [' ','W'], x <- [' ','P'], xs <- if w == 'W' then p (n-1) else pw (n-1)]
it isn't as clean as possible, but I always find list comprehensions bring an elegance to the problem :). Totally worth it.

Related

How many elements are the same in two lists, which have duplicate elements

I try to find the number of elements that are the same in two lists. There are duplicate elements in two lists.
What I want:
-- (because there are two 's' in both lists )
duplicateEle "sssf" "ssah" = 2
-- (because there are two 'a' and one 's' in both lists, intotal 3 common elements)
duplicateEle "aass" "aaas" = 3
-- (because there are two 'a' and two 's' in both lists, intotal 4 common elements)
duplicateEle "ssaa" "ssaa" = 4
My strategy is check each element in List1 to see if it is the element in List2.
if each element of the List1 is the element of the List2.
If true, count 1 and delete (Data.List) the corresponding element in the second list.
For example,
input "dddd" "ssdd" output 2 because there are two d in both lists.
First I check if the 1st element in List1 which is d is an element in List2, the result is True, so I delete only one d in List2, count +1, now count is 1.
Then I check if the 2nd element in List1 which is d is an element in List2, the result is also True, so, I delete one d in List2,count +1, now count is 2.
Because there is not any d left in List2, so, the count will stay at 2.
My code is: (wrong)
import Data.List
duplicateEleCount :: [Char] -> [Char] -> Int
duplicateEleCount (x:xs) ys =
let count = if x `elem` ys then do 1 (delete x ys) else 0
in count + duplicateEleCount xs ys
What you wrote is not so Haskelly. Since it's strings, we can sort them, then group:
import Data.List
-- group :: Eq a => [a] -> [[a]] -- Defined in `Data.List'
dupreps :: String -> String -> Int
dupreps a b = r
where
x = group $ sort a
y = group $ sort b
Now we have them both ordered and grouped, we can just advance along the two lists in an obvious way,
r = merge'n'count x y 0
merge'n'count _ [] cnt = cnt
merge'n'count [] _ cnt = cnt
merge'n'count (g:gs) (f:fs) cnt
| head g == head f
= merge'n'count gs fs (cnt + min (length g) (length f))
| head g < head f
= merge'n'count gs (f:fs) cnt
| head g > head f
= merge'n'count (g:gs) fs cnt
So that we have e.g.
> dupreps "aab" "abbc"
2
> dupreps "aab" "aabbc"
3
> dupreps "aabccc" "bbc"
2
The groups g and f in merge'n'count are always non-empty by construction, so using head is OK.
If you just want to find the number of common elements between two lists which have repeated items, you can simply do this:
f x y = length $ nub $ intersect x y
intersect will find the common elements (with repetition*), and nub will get the distinct values from that list.
Note: intersect will only include repetition from the first argument i.e. intersect "ss" "s" will return "ss" but intersect "s" "ss" will return just "s".
EDIT: Based on the clarification, we can use foldl to get the desired outcome like so:
dup x y = fst $ foldl (\acc z -> if z `elem` (snd acc) then ((1 + fst acc), delete z (snd acc)) else acc) (0,y) x
This applies the strategy outlined in the question - if the element is found in current value of second list, increase the count and modify the second list, else do nothing.
I believe, this is what you intended to write?
import Data.List
duplicateEleCount :: [Char] -> [Char] -> Int
duplicateEleCount (x:xs) ys =
let (count, ys') = if x `elem` ys then (1, delete x ys) else (0, ys)
in count + duplicateEleCount xs ys'
duplicateEleCount [] _ = 0
You can't use do like you were trying to do. Remember that all variables in Haskell are immutable, so delete doesn't change the original list, it returns a new one that we will have to pass along to the recursive call.
A note on performance: this function is O(n*m), since we have to traverse the whole second list for every element in the first list. We can sort the lists first and perform something similar to the merge operation from merge sort to bring it down to O(n*log(n) + m*log(m))).
On another note, because of haskell's laziness, we can split the function up to one like this, without losing any performance and gaining flexibility:
import Data.List
duplicateElems :: [Char] -> [Char] -> [Char]
duplicateElems (x:xs) ys =
if x `elem` ys
then x : duplicateElems xs (delete x ys)
else duplicateElems xs ys
duplicateElems [] _ = []
duplicateEleCount xs ys = length $ duplicateElems xs ys

split an arbitrary set s into two subsets of fixed size

In order to split an arbitrary set s into two subsets l and r, in which l has a fixed size n, I have written the following code:
parts :: Int -> [a] -> [([a], [a])]
parts n ls = (filter len . f) ls
where len (lhs,rhs) = length lhs==n -- the condition that the left subset is of fixed size n
f [] = [([],[])]
f (x:xs) = [ (x:l,r) | (l,r)<-f xs] ++ [ (l,x:r) | (l,r)<-f xs]
Here is a sample of its effect. Evaluating parts 2 "12345" yields:
[ ("12","345")
, ("13","245")
, ("14","235")
, ("15","234")
, ("23","145")
, ("24","135")
, ("25","134")
, ("34","125")
, ("35","124")
, ("45","123")
]
Please notice that my solution enumerates all subsets and then filters out the desired ones. I suppose the subsets function is familiar to you:
subsets :: [a] -> [[a]]
subsets [] = [[]]
subsets (x:xs) = map (x:) (subsets xs) ++ subsets xs
Personally, I find my solution disappointing. It filters the correct answers from a larger set. My question to the reader is:
Can you come up with a function that is equivalent to parts, but produces the answer directly without this a-posteriory filter?
Inspired by subsets, you might end up with
import Control.Arrow (first, second)
-- first f (x,y) = (f x, y) ; second f (x, y) = (x, f y)
parts n xs = parts' 0 xs where
parts' l (x:xs) | l < n = map (first (x:)) (parts' (l + 1) xs) ++ -- 1a
map (second (x:)) (parts' l xs) -- 1b
parts' l xs | l == n = [([],xs)] -- 2
parts' _ _ = [] -- 3
l contains the length of the first pair so far. As long as the pair isn't yet long enough, we take the first element of the list, and append it to all first elements in our pairs (1a). We're also going to map it onto the second elements (1b). Note that in this case the length of the first pairs didn't increase.
When the first pairs just happen to be long enough (2), we're going to put all other elements into the second half of the pair.
When the requirements for the guards do not hold (list exhausted), we return [] (3). This approach also retains the relative ordering of elements:
> parts 2 "12345"
[
("12","345"),
("13","245"),
("14","235"),
("15","234"),
("23","145"),
("24","135"),
("25","134"),
("34","125"),
("35","124"),
("45","123")
]
This approach will also work on infinite lists:
> map (second (const "...")) $ take 5 $ parts 3 [1..]
[([1,2,3],"..."),([1,2,4],"..."),([1,2,5],"..."),([1,2,6],"..."),([1,2,7],"...")]
(The second elements in the pairs will still be infinite lists)
Ok this is what I came up with:
parts :: Int -> [a] -> [([a],[a])]
parts n list = parts' 0 (length list) [] [] list where
parts' _ _ ls rs [] = [(ls,rs)]
parts' n' l ls rs as#(x:xs) | n' >= n = [(reverse ls, reverse rs ++ as)]
| n' + l <= n = [(reverse ls ++ as, reverse rs)]
| otherwise = parts' (n' + 1) (l - 1) (x : ls) rs xs
++ parts' n' (l - 1) ls (x : rs) xs
If it doesn't matter if the elements of the subsets are in the same order as they were in the original set, then you can remove the four uses of reverse.
Sliding split can be done using zipWith of inits and tails. For each split produce the solution for a smaller sublist, and append the element at the point of split to all such solutions.
parts 0 xs = [([],xs)]
parts n xs = concat $ zipWith f (inits xs) (init $ tails xs) where
f hs (h:ts) = [(h:t', hs++ts') | (t', ts') <- parts (n-1) ts]
-- f hs [] not possible - init $ tails xs does not produce empty lists

Generating a list which is made by right shifting elements n times

I am trying a problem recently. And in this case I am having few problems.
Input: generatingListforRightShifting 2 [1,2,3,4,5,6,7,8]
Output: [[1,2,3,4,5,6,7,8],[8,1,2,3,4,5,6,7],[7,8,1,2,3,4,5,6]]
As you understand this program will shift an element in right direction. The 1st argument indicates how many times it will do shifting.
As a newbie I am trying solving it few well known list functions. and using recursion. But to me recursion idea is not clear. My code is:
generatingListforRightShifting' _ []=[]
generatingListforRightShifting' 0 x=x
generatingListforRightShifting' n xs= newList where
newList=takeWhile(\i->[1..n]
<=n)(reverse(take
i(reverse xs))++reverse(drop i(reverse xs)))
I understand that the main mistake I'm doing is in the part takeWhile. But how can I iterate through n times. I have already made a program which directly shows the shifted result such as
Input:generatingListforRightShifting 2 [1,2,3,4,5,6,7,8]
Output: [7,8,1,2,3,4,5,6]
But when I try to get all previous shifting I cannot.
Can anyone help me out here. I also welcome you if you give me the solving idea.
This is more commonly known as rotating instead of shifting. Rotating the list right once is simple, as there are methods to get the last element and the the sublist of all elements but the last.
rotateOnce lst = (last lst):(init lst)
Also note that the rotating twice is equivalent to calling rotateOnce twice. Therefore, the method could be implemented simply as a recursion from the previous result:
rotateN 0 lst = [lst]
rotateN n lst = lst : rotateN (n-1) ((last lst):(init lst))
(Note: that may not be the most optimal solution.)
You can define "shift" recursively: shift 0 is a no-op, shift 1+n (x:xs) is shift n xs.
Something like:
shift 0 = \x -> x
shift n = \lst#(x:xs) -> (shift (n-1) xs)
-- example:
sh3 = shift 3
Then the 'rotate' problem becomes easier:
rotate n = \lst -> (shift lst) ++ (take n lst)
You seem to prefer that we fix your code than start again, so
let's have a look at your code. Firstly, the main list chopping:
reverse (take i (reverse xs)) ++ reverse (drop i (reverse xs))
Now reverse (take i (reverse xs)) takes i elements from the end of the list,
but you reverse the list twice to achieve this, and it would be better to do
drop (length xs - i) xs. Similarly, you can implement reverse (drop i (reverse xs)))
as take (length xs - i) xs. That gives us
drop (length xs - i) xs ++ take (length xs - i) xs
Now your code \i->[1..n]<=n doesn't make sense because it compares the list [1..n]
with n, which can't work. I think you're trying to make a loop where i runs from
1 to n, which is a good plan. Let's use a list comprehension to get the ones we wanted:
[drop (length xs - i) xs ++ take (length xs - i) xs | i <- [1 .. length xs], i <= n]
but now we're running from 1 to the length of the list but throwing away numbers above n,
which would be better written
[drop (length xs - i) xs ++ take (length xs - i) xs | i <- [1..n]]
This does allow n to be more than length xs, but I don't see a big issue there, we could check that at first.
Notice now that we're only using i in the form (length xs - i), and really we're recalculating
length xs an awful lot more than we should, so instead of letting i run from 1 to n, and using
length xs - i, why don't we just have j=length xs -i so j runs from length xs to length xs - n:
[drop j xs ++ take j xs | j <- [length xs,length xs - 1 .. length xs - n]]
which works because for example [6,5..1] == [6,5,4,3,2,1]
It would be neater to do
let l = length xs in
[drop j xs ++ take j xs | j <- [l,l - 1 .. l - n]]
or maybe you like to take more than you like to do arithmetic, so we could use:
let l = length xs in
take n [drop j xs ++ take j xs | j <- [l,l - 1 .. 0]]
which has the added benefit of stopping you doing too many, stopping
you when you get back to the start.
I'd rename your function from generatingListforRightShifting to rotationsR, giving
rotationsR n xs = let l = length xs in
take n [drop j xs ++ take j xs | j <- [l,l - 1 ..]]
Which gives rotationsR 6 [1..4] == [[1,2,3,4],[4,1,2,3],[3,4,1,2],[2,3,4,1],[1,2,3,4]].
Left rotation would look simpler:
rotationsL n xs = take n [drop j xs ++ take j xs | j <- [0..length xs]]
Digression: I couldn't help myself, sorry, and I started again.
I still don't like all that dropping and taking every single time, I'd rather pop
infinitely many copies of xs next to each other (cycle xs) and take infinitely
many tails of that, chopping them all to the right length, but just give you the first n:
rotationsL' n xs = let l = length xs in
take n . map (take l) . tails . cycle $ xs
Because of lazy evaluation, only a finite amount of cycle xs ever gets calculated,
but this one can run and run: rotationsL' 10 [1..4] gives you:
[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3],[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3],[1,2,3,4],[2,3,4,1]]
It would be nice to do the right roations that way too, but it doesn't work because
I'd need to start at the end of an infinite list and work my way back. Let's reuse
your reverse, take what you need, reverse trick again, though:
rotationsR' n xs = let l = length xs in
take n . map (reverse.take l) . tails . cycle . reverse $ xs
Undigression: If you'd rather stick more closely to your original code, you can do
generatingListforRightShifting n xs =
[reverse (take i (reverse xs)) ++ reverse (drop i (reverse xs)) | i <- [1..n]]
I would drop the current approach, which is very convoluted. Instead, focus on abstracting the different components of the operation. If you break the operation into parts, you will notice that there are two symmetric components: rotating the list to the left, and rotating the list to the right. The operation you wish to define iterates the right rotation a specified number of times over some list. This suggests that the desired operation can be defined by taking a specified number of iterations of either the left or right rotation. For example,
left :: [a] -> [a]
left [] = []
left xs = tail xs ++ [head xs]
right :: [a] -> [a]
right [] = []
right xs = last xs : init xs
shiftL :: Int -> [a] -> [[a]]
shiftL n = take n . iterate left
shiftR :: Int -> [a] -> [[a]]
shiftR n = take n . iterate right
Using cycle here seems nice:
shifts n xs = take (n+1) $ shifts' (cycle xs)
where
len = length xs
shifts' ys = take len ys:shifts' (drop (len-1) ys)
I find a left rotation to be very straight forward using splitAt:
import Data.Tuple (swap)
rotateLeft n = uncurry (++) . swap . splitAt n
> rotateLeft 2 "Hello World!"
>>> "llo World!He"

How to remove an element from a list in Haskell?

The function I'm trying to write should remove the element at the given index from the given list of any type.
Here is what I have already done:
delAtIdx :: [x] -> Int -> [x]
delAtIdx x y = let g = take y x
in let h = reverse x
in let b = take (((length x) - y) - 1) h
in let j = g ++ (reverse b)
in j
Is this correct? Could anyone suggest another approach?
It's much simpler to define it in terms of splitAt, which splits a list before a given index. Then, you just need to remove the first element from the second part and glue them back together.
reverse and concatenation are things to avoid if you can in haskell. It looks like it would work to me, but I am not entirely sure about that.
However, to answer the "real" question: Yes there is another (easier) way. Basically, you should look in the same direction as you always do when working in haskell: recursion. See if you can make a recursive version of this function.
Super easy(I think):
removeIndex [] 0 = error "Cannot remove from empty array"
removeIndex xs n = fst notGlued ++ snd notGlued
where notGlued = (take (n-1) xs, drop n xs)
I'm a total Haskell noob, so if this is wrong, please explain why.
I figured this out by reading the definition of splitAt. According to Hoogle, "It is equivalent to (take n xs, drop n xs)". This made me think that if we just didn't take one extra number, then it would be basically removed if we rejoined it.
Here is the article I referenced Hoogle link
Here's a test of it running:
*Main> removeIndex [0..10] 4
[0,1,2,4,5,6,7,8,9,10]
deleteAt :: Int -> [a] -> [a]
deleteAt 0 (x:xs) = xs
deleteAt n (x:xs) | n >= 0 = x : (deleteAt (n-1) xs)
deleteAt _ _ = error "index out of range"
Here is my solution:
removeAt xs n | null xs = []
removeAt (x:xs) n | n == 0 = removeAt xs (n-1)
| otherwise = x : removeAt xs (n-1)
remove_temp num l i | elem num (take i l) == True = i
| otherwise = remove_temp num l (i+1)
remove num l = (take (index-1) l) ++ (drop index l)
where index = remove_temp num l 1
Call 'remove' function with a number and a list as parameters. And you'll get a list without that number as output.
In the above code, remove_temp function returns the index at which the number is present in the list. Then remove function takes out the list before the number and after the number using inbuilt 'take' and 'drop' function of the prelude. And finally, concatenation of these two lists is done which gives a list without the input number.

creating infinte reverse add then sort

i'm trying to create an infinte reverse add then sort list in haskell
r = map head (iterate rlist [2..])
rlist (x:xs) = [x : xs | x <- xs , x quick $ p+x ]
where p = reverse x
quick [] = []
quick (x:xs) = quick [u |u <- xs, u < x] ++ [x] ++ quick [u | u <- xs , u >= x]
but its not working, any suggestions?
thanks.
I'm not sure how you expect your code to work (perhaps there was a problem when you posted the code). Namely, part of your list comprehension ... x quick $ p + x makes no sense to me - x isn't a function and it isn't a list so reverse x also makes no sense. For that matter you have shadowed x - notice the x in your list comprehension isn't the same as the x in ratslist (x:xs).
A simple solution does exist using read and show to convert the numbers to lists of digits (well, characters, but it works) and back:
import Data.List
myRats = 1 : map ratify myRats
-- Alternatively: myRats = iterate ratify 1
ratify :: Integer -> Integer
ratify n = sortRat (n + rev n)
where
rev = read . reverse . show
sortRat = read . sort . show
And in GHCi:
*Main Data.List> take 10 myRats
[1,2,4,8,16,77,145,668,1345,6677]
I don't quite get your problem, but according to your example, I'd try
rats x = sort (zipWith (+) x (reverse x))
like in rats [1,4,5] which equals [6,6,8].

Resources