fun officiate (clist , mlist , score) =
let val hlist = []
in
let
fun appendh ([], _, score) = hlist
| appendh (_, [], score) = hlist
| appendh (c :: clist', m :: mlist', score) =
case (sum_cards(hlist) > score, m) of
(true, _) => hlist
| (false, Draw) => c :: appendh(clist', mlist', score)
| (false, Discard a) => remove_card(hlist, a, IllegalMove) # appendh(clist', mlist', score)
in
score(appendh(clist, mlist, score), score)
end
end
//val officiate = fn : card list * move list * int -> int
//val score = fn : card list * int -> int
When I use this function， I caught this bug ：
use "hw2.sml";
[opening hw2.sml]
hw2.sml:137.6-137.48 Error: operator is not a function [tycon mismatch]
operator: int
in expression:
score (appendh (clist,mlist,score),score)
val it = () : unit
The datatype I set before：
datatype suit = Clubs | Diamonds | Hearts | Spades
datatype rank = Jack | Queen | King | Ace | Num of int
type card = suit * rank
datatype color = Red | Black (*spades and clubs are black,diamonds and hearts are red)*)
datatype move = Discard of card | Draw
exception IllegalMove
And I use the score function I create before， It can work correctly：
fun score (xs, score) =
let val sum = sum_cards(xs)
in
case (all_same_color(xs), sum > score) of
(true, true) => (3 * (sum - score)) div 2
| (true, false) => (score - sum) div 2
| (false, true) => 3 * (sum - score)
| (false, false) => score - sum
end
I got it, I can use the variable score which is the score function.
Related
i need to define an instance for the class Enum based on the datatype Int'. I just need to define the functions toEnum and fromEnum.
For example: map fromEnum [Minus One .. Plus (Succ’ One)] -> [-1,0,1,2]
data PosNat = One | Succ' PosNat
data Int' = Zero' | Plus PosNat | Minus PosNat
instance Enum Int' where
toEnum 0 = Zero'
toEnum n | n>0 = Plus (toPosNat n )
toEnum n | n<0 = undefined -- Minus (toPosNat n)
where
toPosNat :: a -> PosNat
toPosNat 1 = One
toPosNat n | n>1 = (Succ' (toPosNat (n-1)) )
toPosNat n | n<1 = (Succ' (toPosNat (n+1)) )
The problem is, i get following error:
Variable not in scope: toPosNat :: Int -> PosNat
|
62 | toEnum n | n>0 = Plus (toPosNat n )
|
Thanks for your help! :)
A where clause attaches to all of the guards of a single pattern. You've defined your function using three separate patterns, so the where clause only attaches to the last of them. To fix this, simply roll the last two patterns (which are the same, minus the guards) together:
instance Enum Int' where
toEnum 0 = Zero'
toEnum n | n>0 = Plus (toPosNat n )
| n<0 = Minus (toPosNat n)
where
toPosNat :: a -> PosNat
toPosNat 1 = One
toPosNat n | n>1 = (Succ' (toPosNat (n-1)))
| n<1 = (Succ' (toPosNat (n+1)))
I've made the same change to toPosNat because this is better style, but it has no semantic impact in this case.
You need to promote toPosNat to a top-level function, like this:
instance Enum Int' where
toEnum 0 = Zero'
toEnum n | n>0 = Plus (toPosNat n )
toEnum n | n<0 = undefined -- Minus (toPosNat n)
toPosNat :: a -> PosNat
toPosNat 1 = One
toPosNat n | n>1 = (Succ' (toPosNat (n-1)) )
toPosNat n | n<1 = (Succ' (toPosNat (n+1)) )
The where clause that you have in your code is only visible in the third case, not in the second case.
The following code with any real-logic "hollowed out" still runs out of memory when compiled on GHC 7.10.3 with the -O flag. I do not understand why a simple tree recursion with at-most a stack-depth of 52 (number of cards in a standard deck) needs so much memory. I tried using seq on the result variables, but that did not help. Could someone take a look and let me know why the memory usage is so high, and what can I do to avoid it?
import qualified Data.Map.Strict as M
type Card = (Int, Char)
compute_rank_multiplicity_map :: [Card] -> M.Map Int Int
compute_rank_multiplicity_map cards = M.fromList [(x, x) | (x, _) <- cards]
determine_hand :: [Card] -> (Int, [(Int, Int)])
determine_hand [] = error "Card list is empty!"
determine_hand cards = (0, mult_rank_desc_list)
where rank_mult_map = compute_rank_multiplicity_map cards
mult_rank_desc_list = M.toDescList rank_mult_map
check_kicker_logic :: [Card] -> (Int, Int)
check_kicker_logic cards =
let first_cards = take 5 cards
second_cards = drop 5 cards
first_hand#(f_h, f_mrdl) = determine_hand first_cards
second_hand#(s_h, s_mrdl) = determine_hand second_cards
in if (first_hand > second_hand) || (first_hand < second_hand) -- is there a clear winner?
then if (f_h == s_h) && (head f_mrdl) == (head s_mrdl) -- do we need kicker logic?
then (1, 1)
else (0, 1)
else (0, 0)
card_deck :: [Card]
card_deck = [(r, s) | r <- [2 .. 14], s <- ['C', 'D', 'H', 'S']]
need_kicker_logic :: [Card] -> (Int, Int)
need_kicker_logic cards = visit_subset cards (length cards) [] 0 (0, 0)
where visit_subset a_cards num_a_cards picked_cards num_picked_cards result#(num_kicker_logic, num_clear_winners)
| num_cards_needed == 0 = (num_kicker_logic + nkl, num_clear_winners + ncw)
| num_cards_needed > num_a_cards = result
| otherwise = let result_1 = visit_subset (tail a_cards)
(num_a_cards - 1)
picked_cards
num_picked_cards
result
result_2 = visit_subset (tail a_cards)
(num_a_cards - 1)
((head a_cards) : picked_cards)
(num_picked_cards + 1)
result_1
in result_2
where num_cards_needed = 10 - num_picked_cards
(nkl, ncw) = check_kicker_logic picked_cards
main :: IO ()
main =
do
putStrLn $ show $ need_kicker_logic card_deck
This is closely related to a the question: How to map the indexes of a matrix to a 1-dimensional array (C++)?
I need to assign a reversible index to each non-zero element in a banded matrix.
In the normal, full matrix it is easy to do:
|-------- 5 ---------|
Row ______________________ _ _
0 |0 1 2 3 4 | |
1 |5 6 7 8 9 | 4
2 |10 11 12 13 14| |
3 |15 16 17 18 19| _|_
|______________________|
Column 0 1 2 3 4
To find the array index we just use the following bijective formula:
matrix[ i ][ j ] = array[ i*m + j ]
In my case, we have a symmetrically banded matrix with some constraint on distance from the diagonal. For example, the following uses an upper and lower bound of 1:
|-------- 5 ---------|
Row ______________________ _ _
0 |0 1 X X X | |
1 |2 3 4 X X | 4
2 |X 5 6 7 X | |
3 |X X 8 9 10| _|_
|______________________|
Column 0 1 2 3 4
In this case, I want to assign an index position to each element within the bandwidth, and ignore everything outside. There are a couple of ways to do this, one of which is to create a list of all the acceptable indices ix's, and then use map lookups to quickly go back and forth between a (row,col) pair and a singular index:
ix's :: [(Int,Int)] -- List of all valid indices
lkup :: Map (Int,Int) Int
lkup = M.fromList $ zip ix's [0..]
rlkup :: Map Int (Int, Int)
rlkup = M.fromList $ zip [0..] ix's
fromTup :: (Int, Int) -> Int
fromTup tup = fromMaybe 0 $ M.lookup tup lkup
toTup :: Int -> (Int, Int)
toTup i = fromMaybe (0,0) $ M.lookup i rlkup
For large matrices, this leads to a huge number of map lookups, which causes a bottleneck. Is there a more efficient formula to translate between the valid addresses, k, and (row,col) pairs?
You might find it more straightforward to "waste" a few indexes at the beginning and end of the matrix, and so assign:
Row ______________________ _ _
0 (0) |1 2 X X X | |
1 |3 4 5 X X | 4
2 |X 6 7 8 X | |
3 |X X 9 10 11 | _|_
|______________________|
Column 0 1 2 3 4
where (0) is an ignored index.
This is similar to the band matrix representation used by the highly respected LAPACK library.
You just need to take care that the unused elements are properly ignored when performing operations where they might affect used elements. (For example, a fast fill routine can be written without regard to which elements are used or unused; but a matrix multiplication would need to take a little more more care.)
If you take this approach, then the bijections are pretty simple:
import Data.Char
import Data.Maybe
type Index = Int
-- |(row,col) coordinate: (0,0) is top level
type Coord = (Int, Int)
-- |Matrix dimensions: (rows, cols, edges) where edges gives
-- the count of auxiliary diagonals to *each side* of the main
-- diagonal (i.e., what you call the maximum distance), so the
-- total band width is 1+2*edges
type Dims = (Int, Int, Int)
-- |Get index for (row,col)
idx :: Dims -> Coord -> Index
idx (m, n, e) (i, j) = let w = 1+2*e in w*i+(j-i+e)
-- |Get (row,col) for index
ij :: Dims -> Index -> Coord
ij (m, n, e) idx = let w = 1+2*e
(i, j') = idx `quotRem` w
in (i, j'+i-e)
--
-- test code
--
showCoords :: Dims -> [(Coord, Char)] -> String
showCoords (m, n, _) cs =
unlines $
for [0..m-1] $ \i ->
for [0..n-1] $ \j ->
fromMaybe '.' $ lookup (i,j) cs
where for = flip map
test :: Dims -> IO ()
test dm#(m,n,_) = do
putStrLn $ "Testing " ++ show dm
let idxs = [0..]
-- get valid index/coordinates for this matrix
let cs = takeWhile (\(_, (i,j)) -> i<m || j<n)
$ filter (\(_, (i,j)) -> i>=0 && j>=0)
$ map (\ix -> (ix, ij dm ix)) idxs
-- prove the coordinates are right
putStr $ showCoords dm (map (\(ix, (i,j)) -> ((i,j), chr (ord 'A' + ix))) cs)
-- prove getIndex inverts getCoord
print $ all (\(ix, (i,j)) -> idx dm (i,j) == ix) cs
putStrLn ""
main = do test (4, 5, 1) -- your example
test (3, 8, 2) -- another example
I'm solving the Brigde and torch problem
in Haskell.
I wrote a function that given a state of the puzzle, as in which people have yet to cross and those who have crossed, gives back a list of all possible moves from one side to the other (moving two people forwards and one person backwards).
module DarkBridgeDT where
data Crossing = Trip [Float] [Float] Float deriving (Show)
data RoundTrip = BigTrip Crossing Crossing deriving (Show)
trip :: [Float] -> [Float] -> Float -> Crossing
trip x y z = Trip x y z
roundtrip :: Crossing -> Crossing -> RoundTrip
roundtrip x y = BigTrip x y
next :: Crossing -> [RoundTrip]
next (Trip [] _ _) = []
next (Trip (a:b:[]) s _ )
|a>b = [BigTrip (Trip [] (a:b:s) a) (Trip [] [] 0)]
|otherwise = [BigTrip (Trip [] (b:a:s) b) (Trip [] [] 0)]
next (Trip d s _) = [BigTrip (Trip [x,z] (i:j:s) j) b | i <- d, j <- d, i < j, x <- d, z <- d, x < z, z /= i, z /= j, x /= z, x /= i, x /= j, b <- (back [x,z] (i:j:s))]
where
back [] s = []
back d s = [Trip (i:d) (filter (/= i) s) i | i <- s]
Now I need a function that given a state as the one above and a maximum amount of time gives back all possible solutions to the puzzle in less than that given time.
All I have for that is this:
cross :: Crossing -> Float -> [[RoundTrip]]
cross (Trip [] _ _) _ = []
cross (Trip _ _ acu) max
| acu > max = []
cross (Trip a b acu) max = map (cross (map (crec) (next (Trip a b acu)) acu)) max
where
crec (BigTrip (Trip _ _ t1) (Trip a b t2)) acu = (Trip a b (t1+t2+acu))
Of course that doesn't compile, the 5th line is the one that's driving me insane. Any input?
Edit:
The cross function is meant to apply the next function to every result of the last nextfunction called.
If the first result of next was something like: [A,B,C,D] then it would call next on A B C and D to see if any or all of those get to a solution in less than max (A B C and D would be Crossings inside which contain the floats that are the time that ads up and is compared to max).
My data structure is
Crossing: Contains the first side of the bridge (the people in it represented by the time they take to cross the bridge) the other side of the bridge (the same as the other) and a time that represents the greatest time that last crossed the bridge (either the greatest of the two in the first crossing or the only one in the second) or the amount of time acumulated crossing the bridge (in the cross function).
RoundTrip: Represents two crossings, the first and the second, the one getting to safety and the one coming back to danger.
cross (Trip [1,2,5,10] [] 0) 16 should give an empty list for there is no solution that takes less than 17 minutes (or whatever time unit).
cross (Trip [1,2,5,10] [] 0) 17 should give the normal solution to the puzzle as a list of roundtrips.
I hope that makes it clearer.
Edit2:
I finally got it. I read Carsten's solution before I completed mine and we laid it out practically the same. He used fancier syntax and more complex structures but it's really similar:
module DarkBridgeST where
data Torch = Danger | Safety deriving (Eq,Show)
data State = State
[Float] -- people in danger
[Float] -- people safe
Torch -- torch position
Float -- remaining time
deriving (Show)
type Crossing = [Float]
classic :: State
classic = State [1,2,5,10] [] Danger 17
next :: State -> [Crossing] -- List all possible moves
next (State [] _ _ _) = [] -- Finished
next (State _ [] Safety _) = [] -- No one can come back
next (State danger _ Danger rem) = [[a,b] | a <- danger, b <- danger, a /= b, a < b, max a b <= rem]
next (State _ safe Safety rem) = [[a] | a <- safe, a <= rem]
cross :: State -> Crossing -> State -- Crosses the bridge depending on where the torch is
cross (State danger safe Danger rem) cross = State (taking cross danger) (safe ++ cross) Safety (rem - (maximum cross))
cross (State danger safe Safety rem) cross = State (danger ++ cross) (taking cross safe) Danger (rem - (maximum cross))
taking :: [Float] -> [Float] -> [Float]
taking [] d = d
taking (x:xs) d = taking xs (filter (/=x) d)
solve :: State -> [[Crossing]]
solve (State [] _ _ _) = [[]]
solve sf = do
c <- next sf
let sn = cross sf c
r <- solve sn
return (c:r)
All in all thanks everyone. I'm new to Haskell programming and this helped me understand a lot of things. I hope this post can also help someone starting haskell like me one day :)
I'm not going to leave much of your code intact here.
The first problems are with the data structures. Crossing doesn't actually represent anything to do with crossing the bridge, but the state before or after a bridge crossing. And you can't use RoundTrip because the number of bridge crossings is always odd.
I'm renaming the data structure I'm actually keeping, but I'm not keeping it unmodified.
data Bank = Danger | Safety deriving (Eq,Show)
data PuzzleState = PuzzleState
[Float] -- people still in danger
[Float] -- people on the safe bank
Bank -- current location of the torch
Float -- remaining time
type Crossing = ([Float],Bank)
Modifying/writing these functions is left as an exercise for the reader
next :: PuzzleState -> [Crossing] -- Create a list of possible crossings
applyCrossing :: PuzzleState -> Crossing -> PuzzleState -- Create the next state
Then something like this function can put it all together (assuming next returns an empty list if the remaining time is too low):
cross (PuzzleState [] _ _ _) = [[]]
cross s1 = do
c <- next s1
let s2 = applyCrossing s1 c
r <- cross s2
return $ c : r
Just for the fun, an approach using a lazy tree:
import Data.List
import Data.Tree
type Pawn = (Char, Int)
data Direction = F | B
data Turn = Turn {
_start :: [Pawn],
_end :: [Pawn],
_dir :: Direction,
_total :: Int
}
type Solution = ([String], Int)
-- generate a tree
mkTree :: [Pawn] -> Tree Turn
mkTree p = Node{ rootLabel = s, subForest = branches s }
where s = Turn p [] F 0
-- generates a node for a Turn
mkNode :: Turn -> Tree Turn
mkNode t = Node{ rootLabel = t, subForest = branches t }
-- next possible moves
branches :: Turn -> [Tree Turn]
-- complete
branches (Turn [] e d t) = []
-- moving forward
branches (Turn s e F t) = map (mkNode.turn) (next s)
where
turn n = Turn (s\\n) (e++n) B (t+time n)
time = maximum . map snd
next xs = [x| x <- mapM (const xs) [1..2], head x < head (tail x)]
-- moving backward
branches (Turn s e B t) = map (mkNode.turn) e
where
turn n = Turn (n:s) (delete n e) F (t+time n)
time (_,b) = b
solve :: Int -> Tree Turn -> [Solution]
solve limit tree = solve' [] [] limit tree
where
solve' :: [Solution] -> [String] -> Int -> Tree Turn -> [Solution]
solve' sols cur limit (Node (Turn s e d t) f)
| and [t <= limit, s == []] = sols ++ [(cur++[step],t)]
| t <= limit = concat $ map (solve' sols (cur++[step]) limit) f
| otherwise = []
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]"
v = map fst
Then you you can get a list of solutions:
solve 16 $ mkTree [('a',2), ('b',4), ('c',8)]
=> [(["[abc|]","[c|ab]","[ac|b]","[|bac]"],14),(["[abc|]","[c|ab]","[bc|a]","[|abc]"],16),(["[abc|]","[b|ac]","[ab|c]","[|cab]"],14),(["[abc|]","[a|bc]","[ba|c]","[|cab]"],16)]
Or also generate a tree of solutions:
draw :: Int -> Tree Turn -> Tree String
draw limit (Node (Turn s e d t) f)
| t > limit = Node "Time Out" []
| s == [] = Node ("Complete: " ++ step) []
| otherwise = Node step (map (draw limit) f)
where step = "[" ++ (v s) ++ "|" ++ (v e) ++ "]" ++ " - " ++ (show t)
v = map fst
Then:
putStrLn $ drawTree $ draw 16 $ mkTree [('a',2), ('b',4), ('c',8)]
Will result in:
[abc|] - 0
|
+- [c|ab] - 4
| |
| +- [ac|b] - 6
| | |
| | `- Complete: [|bac] - 14
| |
| `- [bc|a] - 8
| |
| `- Complete: [|abc] - 16
|
+- [b|ac] - 8
| |
| +- [ab|c] - 10
| | |
| | `- Complete: [|cab] - 14
| |
| `- [cb|a] - 16
| |
| `- Time Out
|
`- [a|bc] - 8
|
+- [ba|c] - 12
| |
| `- Complete: [|cab] - 16
|
`- [ca|b] - 16
|
`- Time Out
I need to derive Eq for a data, but for some constructors I want to ignore some fields.
The data is for representing DataTypes (we are developing a compiler):
data DataType
= Int | Float | Bool | Char | Range | Type
| String Width
| Record (Lexeme Identifier) (Seq Field) Width
| Union (Lexeme Identifier) (Seq Field) Width
| Array (Lexeme DataType) (Lexeme Expression) Width
| UserDef (Lexeme Identifier)
| Void | TypeError
deriving (Ord)
I need to ignore the Width field from every contstructor it appears in.
You cannot derive Eq if you wish to use custom Eq semantics. You must write an instance by hand.
A common trick is to:
define a DataType' that drops the fields you wish to ignore
derive Eq for this
define Eq for DataType as a == b = toDataType' a == toDataType' b
This at least makes it less ad hoc, capturing the different Eq semantics in its own type, where it /can/ be derived.
Another approach from Don's is to use a wrapper type to encode the instances you want for the special fields:
newtype Metadata a = Metadata { unMetadata :: a }
instance Eq (Metadata a) where
(==) _ _ = True
instance Ord (Metadata a) where
compare _ _ = EQ
You can then replace all the Width's in your DataType definition with Metadata Width and derive the instances.
data DataType
= Int | Float | Bool | Char | Range | Type
| String (Metadata Width)
| Record (Lexeme Identifier) (Seq Field) (Metadata Width)
| Union (Lexeme Identifier) (Seq Field) (Metadata Width)
| Array (Lexeme DataType) (Lexeme Expression) (Metadata Width)
| UserDef (Lexeme Identifier)
| Void | TypeError
deriving (Eq, Ord)
This solution makes your DataType definition a bit more verbose (and more explicit?) but requires wrapping and unwrapping when using the Width values.
You could write your own instance of Eq:
instance Eq DataType where
Int == Int = True
Float == Float = True
Bool == Bool = True
Char == Char = True
Range == Range = True
Type == Type = True
(String _) == (String _) = True
(Record l1 s1 _) == (Record l2 s2 _) = (l1 == l2) && (s1 == s2)
(Union l1 s1 _) == (Union l2 s2 _) = (l1 == l2) && (s1 == s2)
(Array l1 e1 _) == (Array l1 e1 _) = (l1 == l2) && (e1 == e2)
(UserDef i1) == (UserDef i2) = i1 == i2
Void == Void = True
TypeError == TypeError = True
_ == _ = False