I am brand new to Haskell, so I'm still learning a lot of things. I was given a list of name and age, and I need to sort them in both alphabetical order and in increasing order using their age. I managed to sort the list alphabetically, but I'm unsure how to do it using its age values. What can I change in the code below? Thank you for your help.
qsort :: (Ord a) => [a] -> [a]
-- check to see if the list is empty
qsort [] = []
qsort [x] = [x] -- Single element list is always sorted
qsort [x, y] = [(min x y), (max x y)]
-- x is the pivot, left quicksort returns smaller sorted and right quicksort bigger sorted
qsort (x:xs) =
qsort [a | a <- xs, a <= x] ++ [x] ++ qsort [a | a <- xs, a > x]
people=[("Steve",20),("Smith",31),("Kris",19),("Beth",21)]
main = do
print(qsort people) -- sort alphabetically
First, let's simplify your function a bit. Both the [x] and [x, y] cases are redundant: they are completely captured by the (x:xs) case. So let's remove those.
qsort :: (Ord a) => [a] -> [a]
qsort [] = []
qsort (x:xs) =
qsort [a | a <- xs, a <= x] ++ [x] ++ qsort [a | a <- xs, a > x]
Now, currently we assume that the type of our list and the type we're sorting by are the same. We call them both a. Let's instead have two types: a will be the type of our list and b will be the type we want to sort by. Only b has to satisfy Ord, and we'll need a function to convert an a into a b so we can sort our list. This is our desired type
qsort :: (Ord b) => (a -> b) -> [a] -> [a]
Our base case is basically the same, except that we ignore the function argument.
qsort _ [] = []
In our recursive case, we compare by applying the function f :: a -> b and then using <= or >.
qsort f (x:xs) =
qsort f [a | a <- xs, f a <= f x] ++ [x] ++ qsort f [a | a <- xs, f a > f x]
Now we can sort by whatever Ord type we want. We can sort by the first element of a tuple
-- Note: (fst :: (a, b) -> a) is in Prelude
print (qsort fst people)
or the second
-- Note: (snd :: (a, b) -> b) is in Prelude
print (qsort snd people)
both by their natural sorting order.
If we want to sort in the opposite order (descending rather than ascending), we can use Down as our function. If we want to sort by some complex order, we can always use the newtype pattern.
I'm new to dependent types and, having a Haskell experience, am slowly learning Idris. For an exercize, I want to write a Huffman encoding. Currently I'm trying to write a proof that the "flattening" of the code tree produces a prefix code, but has got stuck with the quantifiers.
I have a simple inductive proposition that one list is a prefix of an another:
using (xs : List a, ys : List a)
data Prefix : List a -> List a -> Type where
pEmpty : Prefix Nil ys
pNext : (x : a) -> Prefix xs ys -> Prefix (x :: xs) (x :: ys)
Is this a valid approach? Or something like "xs is prefix of ys if there is zs such that xs ++ zs = ys" would be better?
Was it the right way to introduce a "forall" quantifier (as far as I can understand, in Agda it would be something like pNext : ∀ {x xs ys} → Prefix xs ys → Prefix (x :: xs) (y :: ys))? Should the pNext first argument be implicit? What is the semantic differences between two variants?
Then, I want to build one for a vector where none of elements forms a prefix of another:
data PrefVect : Vect n (List a) -> Type where
Empty vector has no prefixes:
pvEmpty : PrefVect Nil
and given an element x, a vector xs, and proofs that none element of xs is a prefix of x (and vice versa), x :: xs will hold that property:
pvNext : (x : [a]) -> (xs : Vect n [a]) ->
All (\y => Not (Prefix x y)) xs ->
All (\y => Not (Prefix y x)) xs ->
PrefVect (x :: xs)
This is an unvalid type which I hope to fix after dealing with the first one, but there is similar question about quantifiers in pvNext: is this variant acceptable, or there is a better way to form a "negation on relation"?
Thank you.
I think the only problem here is that you've used [a] as the type of lists of a, in the Haskell style, whereas in Idris it needs to be List a.
Your Prefix type looks fine to me, although I'd write it as:
data Prefix : List a -> List a -> Type where
pEmpty : Prefix [] ys
pNext : Prefix xs ys -> Prefix (x :: xs) (x :: ys)
That is, x can be implicit, and you don't need the using because Idris can infer the types of xs and ys. Whether this is the right approach or not really depends on what you plan to use the Prefix type for. It's certainly easy enough to test whether a list is the prefix of another. Something like:
testPrefix : DecEq a => (xs : List a) -> (ys : List a) -> Maybe (Prefix xs ys)
testPrefix [] ys = Just pEmpty
testPrefix (x :: xs) [] = Nothing
testPrefix (x :: xs) (y :: ys) with (decEq x y)
testPrefix (x :: xs) (x :: ys) | (Yes Refl) = Just (pNext !(testPrefix xs ys
testPrefix (x :: xs) (y :: ys) | (No contra) = Nothing
If you want to prove the negation, which it seems you might, you'll need the type to be:
testPrefix : DecEq a => (xs : List a) -> (ys : List a) -> Dec (Prefix xs ys)
I'll leave that one as an exercise :).
In haskell, how can I generate a balanced partition of a set?
Assuming I have a set {1,3,4,6,9}, a balanced partition of that set would be s1{9,3} and s2{6,4,1}, seeing as s1-s2 is 1.
Well, for brute force, we can generate all partitions recursively by generating partitions for the tail and then putting the head on the left list or the right:
partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
[(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]
have a way to compute the unbalance:
unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)
and then put it all together:
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions
Here's the complete module:
module Balance where
import Data.List(minimumBy)
import Data.Ord(comparing)
partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
[(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]
unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions
Here's a solution that does a little better:
balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = snd . head . partitionsByBadness . sort
where
-- recursively builds a list of possible partitionings and their badness
-- sorted by their (increasing) badness
partitionsByBadness [] = [(0, ([], []))]
partitionsByBadness (x:xs) = let res = partitionsByBadness xs
withX = map ( (+x) *** first (x:)) res
sansX = map (subtract x *** second (x:)) res
in merge withX $ normalize sansX
-- When items are added to the second list, the difference between the sums
-- decreases - and might become negative
-- We take those cases and swap the lists, so that the first list has always
-- a greater sum and the difference is always positive
-- So that we can sort the list again (with linear complexity)
normalize xs = let (neg, pos) = span ((<0) . fst) xs
in merge pos $ reverse $ map (negate *** swap) neg
-- merge two sorted lists (as known from mergesort, but
-- omits "duplicates" with same badness)
merge :: Ord k => [(k, v)] -> [(k, v)] -> [(k, v)]
merge [] zss = zss
merge yss [] = yss
merge yss#(y:ys) zss#(z:zs) = case comparing fst y z of
LT -> y : merge ys zss
EQ -> merge ys zss
GT -> z : merge yss zs
Bin packing works pretty well:
% stack ghci --package Binpack
λ: import Data.BinPack
λ: let bins numberOfBins items = let totalSize = sum items; binSize = succ (totalSize `div` (max 1 numberOfBins)) in binpack WorstFit Decreasing id (replicate numberOfBins (emptyBin binSize)) items
λ: bins 2 [1,3,4,6,9]
([(0,[3,9]),(1,[1,4,6])],[])
If you know your input will fit into the bins you can extract out the partitions:
λ: map snd . fst . bins 2 $ [1,3,4,6,9]
[[3,9],[1,4,6]]
I have two lists of unequal length. When I add both of them I want the final list to have the length of the longest list.
addtwolists [0,0,221,2121] [0,0,0,99,323,99,32,2332,23,23]
>[0,0,221,2220,323,99,32,2332,23,23]
addtwolists [945,45,4,45,22,34,2] [0,34,2,34,2]
>[945,79,6,79,24,34,2]
zerolist :: Int -> [Integer]
zerolist x = take x (repeat 0)
addtwolists :: [Integer] -> [Integer] -> [Integer]
addtwolists x y = zipWith (+) (x ++ (zerolist ((length y)-(length x)))) (y ++ (zerolist ((length x)-(length y))))
This code is inefficient. So I tried:
addtwolist :: [Integer] -> [Integer] -> [Integer]
addtwolist x y = zipWith (+) (x ++ [head (zerolist ((length y)-(length x))) | (length y) > (length x)]) (y ++ [head (zerolist ((length x)-(length y))) | (length x) > (length y)])
Any other way to increase the efficiency?Could you only check once to see which list is bigger?
Your implementation is slow because it looks like you call the length function on each list multiple times on each step of zipWith. Haskell computes list length by walking the entire list and counting the number of elements it traverses.
The first speedy method that came to my mind was explicit recursion.
addLists :: [Integer] -> [Integer] -> [Integer]
addLists xs [] = xs
addLists [] ys = ys
addLists (x:xs) (y:ys) = x + y : addLists xs ys
I'm not aware of any standard Prelude functions that would fill your exact need, but if you wanted to generalize this to a higher order function, you could do worse than this. The two new values passed to the zip function are filler used in computing the remaining portion of the long list after the short list has been exhausted.
zipWithExtend :: (a -> b -> c) -> [a] -> [b] -> a -> b -> [c]
zipWithExtend f [] [] a' b' = []
zipWithExtend f (a:as) [] a' b' = f a b' : zipWithExtend f as [] a' b'
zipWithExtend f [] (b:bs) a' b' = f a' b : zipWithExtend f [] bs a' b'
zipWithExtend f (a:as) (b:bs) a' b' = f a b : zipWithExtend f as bs a' b'
Usage:
> let as = [0,0,221,2121]
> let bs = [0,0,0,99,323,99,32,2332,23,23]
> zipWithExtend (+) as bs 0 0
[0,0,221,2220,323,99,32,2332,23,23]
This can be done in a single iteration, which should be a significant improvement for long lists. It's probably simplest with explicit recursion:
addTwoLists xs [] = xs
addTwoLists [] ys = ys
addTwoLists (x:xs) (y:ys) = x+y:addTwoLists xs ys
Just because I can't help bikeshedding, you might enjoy this function:
Prelude Data.Monoid Data.List> :t map mconcat . transpose
map mconcat . transpose :: Monoid b => [[b]] -> [b]
For example:
> map (getSum . mconcat) . transpose $ [map Sum [0..5], map Sum [10,20..100]]
[10,21,32,43,54,65,70,80,90,100]
Two suggestions:
addtwolists xs ys =
let common = zipWith (+) xs ys
len = length common
in common ++ drop len xs ++ drop len ys
addtwolists xs ys | length xs < length ys = zipWith (+) (xs ++ repeat 0) ys
| otherwise = zipWith (+) xs (ys ++ repeat 0)
Let's define custom operators - let it be ++,equals
:- op(900, yfx, equals).
:- op(800, xfy, ++).
And fact:
check(A equals A).
I try to make predicate, let it be check/1, that will return true in all following situations:
check( a ++ b ++ c ++ d equals c ++ d ++ b ++ a ),
check( a ++ b ++ c ++ d equals d ++ a ++ c ++ b),
check( a ++ b ++ c ++ d equals d ++ b ++ c ++ a ),
% and all permutations... of any amount of atoms
check( a ++ ( b ++ c ) equals (c ++ a) ++ b),
% be resistant to any type of parentheses
return
yes
How to implement this in Prolog? (Code snippet, please. Is it possible? Am I missing something?)
Gnu-Prolog is preferred, but SWI-Prolog is acceptable as well.
P.S. Please treat code, as draft "pseudocode", and don't care for small syntax issues.
P.P.S '++' is just beginning. I'd like to add more operators. That's why I'm afraid that putting stuff into list might be not good solution.
Additionally
Additionally, would be nice, if queries would be possible (but, this part is not required, if you are able to answer to first part, it's great and enough)
check( a ++ (b ++ X) equals (c ++ Y) ++ b) )
one of possible results (thanks #mat for showing others)
X=c, Y=a
I am looking mostly for solution for first part of question - "yes/no" checking.
Second part with X,Y would be nice addition. In it X,Y should be simple atoms. For above example domains for X,Y are specified: domain(X,[a,b,c]),domain(Y,[a,b,c]).
Your representation is called "defaulty": In order to handle expressions of this form, you need a "default" case, or explicitly check for atom/1 (which is not monotonic) - you cannot use pattern matching directly to handle all cases. As a consequence, consider again your case:
check( a ++ (b ++ X) equals (c ++ Y) ++ b) )
You say this should answer X=c, Y=a. However, it could also answer X = (c ++ d), Y = (a ++ d). Should this solution also occur? If not, it would not be monotonic and thus significantly complicate declarative debugging and reasoning about your program. In your case, would it make sense to represent such expressions as lists? For example, [a,b,c,d] equals [c,d,b,a]? You could then simply use the library predicate permutation/2 to check for equality of such "expressions".
It is of course also possible to work with defaulty representations, and for many cases they might be more convenient for users (think of Prolog source code itself with its defaulty notation for goals, or Prolog arithmetic expressions). You can use non-monotonic predicates like var/1 and atom/1, and also term inspection predicates like functor/3 and (=..)/2 to systematically handle all cases, but they usually prevent or at least impede nice declarative solutions that can be used in all directions to test and also generate all cases.
This question is rather old, but I'll post my solution anyways. I'm learning prolog in my spare time, and found this quite a challenging problem.
I learned a lot about DCG and difference lists. I'm afraid, I didn't come up with a solution that does not use lists. Like mat suggested, it transforms terms into flat lists to cope with the parentheses, and uses permutation/2 to match the lists, accounting for the commutative nature of the ++ operator...
Here's what I came up with:
:- op(900, yfx, equ).
:- op(800, xfy, ++).
check(A equ B) :- A equ B.
equ(A,B) :- sum_pp(A,AL,Len), sum_pp(B,BL,Len), !, permutation(AL, BL).
sum_pp(Term, List, Len) :- sum_pp_(Term, List,[], 0,Len).
sum_pp_(A, [A|X],X, N0,N) :- nonvar(A), A\=(_++_), N is N0+1.
sum_pp_(A, [A|X],X, N0,N) :- var(A), N is N0+1.
sum_pp_(A1++A2, L1,L3, N0,N) :-
sum_pp_(A1, L1,L2, N0,N1), (nonvar(N), N1>=N -> !,fail; true),
sum_pp_(A2, L2,L3, N1,N).
The sum_pp/3 predicate is the workhorse which takes a term and transforms it into a flat list of summands, returning (or checking) the length, while being immune to parentheses. It is very similar to a DCG rule (using difference lists), but it is written as a regular predicate because it uses the length to help break the left recursion which would otherwise lead to infinite recursion (took me quite a while to beat it).
It can check ground terms:
?- sum_pp(((a++b)++x++y)++c++d, L, N).
L = [a,b,x,y,c,d],
N = 6 ;
false.
It also generates solutions:
?- sum_pp((b++X++y)++c, L, 5).
X = (_G908++_G909),
L = [b,_G908,_G909,y,c] ;
false.
?- sum_pp((a++X++b)++Y, L, 5).
Y = (_G935++_G936),
L = [a,X,b,_G935,_G936] ;
X = (_G920++_G921),
L = [a,_G920,_G921,b,Y] ;
false.
?- sum_pp(Y, L, N).
L = [Y],
N = 1 ;
Y = (_G827++_G828),
L = [_G827,_G828],
N = 2 ;
Y = (_G827++_G836++_G837),
L = [_G827,_G836,_G837],
N = 3 .
The equ/2 operator "unifies" two terms, and can also provide solutions if there are variables:
?- a++b++c++d equ c++d++b++a.
true ;
false.
?- a++(b++c) equ (c++a)++b.
true ;
false.
?- a++(b++X) equ (c++Y)++b.
X = c,
Y = a ;
false.
?- (a++b)++X equ c++Y.
X = c,
Y = (a++b) ;
X = c,
Y = (b++a) ;
false.
In the equ/2 rule
equ(A,B) :- sum_pp(A,AL,Len), sum_pp(B,BL,Len), !, permutation(AL, BL).
the first call to sum_pp generates a length, while the second call takes the length as a constraint. The cut is necessary, because the first call may continue to generate ever growing lists that will never again match with the second list, leading to infinite recursion. I haven't found a better solution yet...
Thanks for posting such an interesting problem!
/Peter
edit: sum_pp_ written as DCG rules:
sum_pp(Term, List, Len) :- sum_pp_(Term, 0,Len, List, []).
sum_pp_(A, N0,N) --> { nonvar(A), A\=(_++_), N is N0+1 }, [A].
sum_pp_(A, N0,N) --> { var(A), N is N0+1 }, [A].
sum_pp_(A1++A2, N0,N) -->
sum_pp_(A1, N0,N1), { nonvar(N), N1>=N -> !,fail; true },
sum_pp_(A2, N1,N).
update:
sum_pp(Term, List, Len) :-
( ground(Term)
-> sum_pp_chk(Term, 0,Len, List, []), ! % deterministic
; length(List, Len), Len>0,
sum_pp_gen(Term, 0,Len, List, [])
).
sum_pp_chk(A, N0,N) --> { A\=(_++_), N is N0+1 }, [A].
sum_pp_chk(A1++A2, N0,N) --> sum_pp_chk(A1, N0,N1), sum_pp_chk(A2, N1,N).
sum_pp_gen(A, N0,N) --> { nonvar(A), A\=(_++_), N is N0+1 }, [A].
sum_pp_gen(A, N0,N) --> { var(A), N is N0+1 }, [A].
sum_pp_gen(A1++A2, N0,N) -->
{ nonvar(N), N0+2>N -> !,fail; true }, sum_pp_gen(A1, N0,N1),
{ nonvar(N), N1+1>N -> !,fail; true }, sum_pp_gen(A2, N1,N).
I split sum_pp into two variants. The first is a slim version that checks ground terms and is deterministic. The second variant calls length/2 to perform some kind of iterative deepening, to prevent the left-recursion from running away before the right recurson gets a chance to produce something. Together with the length checks before each recursive call, this is now infinite recursion proof for many more cases than before.
In particular the following queries now work:
?- sum_pp(Y, L, N).
L = [Y],
N = 1 ;
Y = (_G1515++_G1518),
L = [_G1515,_G1518],
N = 2 .
?- sum_pp(Y, [a,b,c], N).
Y = (a++b++c),
N = 3 ;
Y = ((a++b)++c),
N = 3 ;
false.