I have to make a function that finds specific sublists.
function :: Integer -> Integer -> [[Integer]]
function n m = …
If m is smaller then n the program exits.
If the (mod (sum [1..n]) m) /= 0 then again error.
Otherwise the program should find sublists.
And the primary list is generated from [1..n]
For example, if the numbers are n = 6 and m = 7. List is [1,2,3,4,5,6] The answer is [[6,1],[5,2],[4,3]].
function 6 7
>>> [[6,1],[5,2],[4,3]]
Order is not necessary. So on I have made these steps. Any help would be useful.Also example codes would be useful. If anyone can solve this problem, I would appreciate it. Code with solution would be very useful for me.
function :: Integer -> Integer -> [[Integer]]
function n m
|m < n = error "m is smaller than n"
|(mod (sum [1..n]) m) /= 0 = error "list sum doesn't devide with m"
|otherwise = …
I would go and create all lists with sum property, for example using list comprehension. And then filtering by the uniqueness property, by something like:
taking list difference of the first sublist and the generatorlist and checking if the next sublist is contained in the generator,
then deleting a sublist if it is not subset of the altered generator
or doing the same procedure as in 1.
you can end the procedure if the sum of the altered generators is less than m
note that the result is depending on how you have sorted all sublists - so the solution is not a unique longest list of sublists, but just one of many results possible with sum and "uniqueness" property.
Edit: Some Code - not perfect maximum solution
just something to start and think about i only collect easy two element lists and otherwise take one maximal list.
The next improvements would be to make a function collecting not only easy but all two element lists and then generalize this to get sublists of a given length, maybe you want to have a look a bit at elementary combinatorics.
module Sublists where
import Data.List ((\\))
subLists :: Int -> Int -> [[Int]]
subLists n = subLists' ([],[1..n])
subLists' :: ([[Int]],[Int]) -> Int -> [[Int]]
subLists' aa m = fst (mLSubLists (tLSubLists aa m) m)
_subLists :: ([Int] -> Int -> [Int]) -> ([[Int]],[Int]) -> Int -> ([[Int]],[Int])
_subLists _ yx#(_,[ ]) _ = yx
_subLists _ yx#(_,[_]) _ = yx
_subLists f yx#(yy,xx) m | sum xx < m = yx
| otherwise = if tt == []
then yx
else _subLists f (tt:yy,xx\\tt) m
where tt = f xx m
tLSubLists :: ([[Int]],[Int]) -> Int -> ([[Int]],[Int])
tLSubLists = _subLists twoList
mLSubLists :: ([[Int]],[Int]) -> Int -> ([[Int]],[Int])
mLSubLists = _subLists manyList
twoList :: [Int] -> Int -> [Int]
twoList [ ] _ = []
twoList [_] _ = []
twoList xx#(x:xs) m | (x + l) < m = []
| x == l = []
| (x + l) `rem` m == 0 = [x,l]
| otherwise = twoList ii m
where l = last xs
ii = init xx
manyList :: [Int] -> Int -> [Int]
manyList xx m | s < m = []
| s == m = xx
| s `rem` m == 0 = xx
| otherwise = manyList xs m
where s = sum xx
xs = tail xx
and some test cases:
import Sublists
import Test.HUnit
import Data.List ((\\))
main = testAll
testAll = runTestTT $ TestList tests
tests :: [Test]
tests = [
"n=6 m=7" ~: "subLists" ~: [[3,4],[2,5],[1,6]]
~=? subLists 6 7,
"n=6 m=7" ~: "twoList" ~: [1,6]
~=? twoList [1..6] 7,
"n=6 m=7" ~: "twoList" ~: [2,5]
~=? twoList ([1..6]\\[1,6]) 7,
"n=6 m=7" ~: "twoList" ~: [3,4]
~=? twoList (([1..6]\\[1,6])\\[2,5]) 7,
"n=6 m=7" ~: "manyList" ~: [2,3,4,5]
~=? manyList [1..5] 7,
"dummy" ~: "dummy" ~: "result"
~=? (\_ -> "result") "function"
]
The function subsequences in Data.List might be helpful, e.g.
subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
Then you "just" need to filter out all sub-lists that don't match your criterias.
Related
I am trying to convert the following function which test the number if it's prime to another one that test if the integer is a circular prime.
eg. 1193 is a circular prime, since 1931, 9311 and 3119 all are also prime.
So i need to rotate the digits of the integer and test if the number is prime or not. any ideas?
note: I am new to Haskell Programming
isPrime :: Integer -> Bool
isPrime 1 = False
isPrime 2 = True
isPrime n
| (length [x | x <- [2 .. n-1], n `mod` x == 0]) > 0 = False
| otherwise = True
isCircPrime :: Integer -> Bool
You can improve the efficiency and elegance of your isPrime function easily by implementing it as:
isPrime :: Integral i => i -> Bool
isPrime 1 = False
isPrime n = all ((/=) 0 . mod n) (takeWhile (\x -> x*x <= n) [2..])
In order to rotate numbers, we can make use of two helper functions here: one to convert a number to a list of digits, and one to convert a list of digits to a number, we do this in reverse, since that is more convenient to implement, but will not matter:
num2dig :: Integral i => i -> [i]
num2dig n | n < 10 = [n]
| otherwise = r : num2dig q
where (q, r) = quotRem n 10
dig2num :: (Foldable t, Num a) => t a -> a
dig2num = foldr ((. (10 *)) . (+)) 0
Now we can make a simple function to generate, for a list of items, all rotations:
import Control.Applicative(liftA2)
import Data.List(inits, tails)
rots :: [a] -> [[a]]
rots = drop 1 . liftA2 (zipWith (++)) tails inits
So we can use this to construct all rotated numbers:
rotnum :: Integral i => i -> [i]
rotnum = map dig2num . rots . num2dig
For example for 1425, the rotated numbers are:
Prelude Control.Applicative Data.List> rotnum 1425
[5142,2514,4251,1425]
I leave using isPrime on these numbers as an exercise.
Referencing your question here, you can achieve what you want by adding a single new function:
check :: Integer -> Bool
check n = and [isPrime (stringToInt cs) | cs <- circle (intToString n)]
This is to add an easier to understand solution from where you already were in your specific code, as I can see you were asking for that specifically. Usage:
*Main> check 1931
True
*Main> check 1019
False
Mind you, I have made some type-changes. I assume you want each function to be type-specific, due to their names. Full code, taken from your example:
circle :: String -> [String]
circle xs = take (length xs) (iterate (\(y:ys) -> ys ++ [y]) xs)
stringToInt :: String -> Integer
stringToInt x = read (x) :: Integer
intToString :: Integer -> String
intToString x = show x
isPrime :: Integer -> Bool
isPrime 1 = False
isPrime 2 = True
isPrime n
| (length [x | x <- [2 .. n-1], n `mod` x == 0]) > 0 = False
| otherwise = True
check :: Integer -> Bool
check n = and [isPrime (stringToInt cs) | cs <- circle (intToString n)]
I have an algorithm for parallel sorting a list of a given length:
import Control.Parallel (par, pseq)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import System.Environment (getArgs)
import System.Random (StdGen, getStdGen, randoms)
parSort :: (Ord a) => [a] -> [a]
parSort (x:xs) = force greater `par` (force lesser `pseq`
(lesser ++ x:greater))
where lesser = parSort [y | y <- xs, y < x]
greater = parSort [y | y <- xs, y >= x]
parSort _ = []
sort :: (Ord a) => [a] -> [a]
sort (x:xs) = lesser ++ x:greater
where lesser = sort [y | y <- xs, y < x]
greater = sort [y | y <- xs, y >= x]
sort _ = []
parSort2 :: (Ord a) => Int -> [a] -> [a]
parSort2 d list#(x:xs)
| d <= 0 = sort list
| otherwise = force greater `par` (force lesser `pseq`
(lesser ++ x:greater))
where lesser = parSort2 d' [y | y <- xs, y < x]
greater = parSort2 d' [y | y <- xs, y >= x]
d' = d - 1
parSort2 _ _ = []
force :: [a] -> ()
force xs = go xs `pseq` ()
where go (_:xs) = go xs
go [] = 1
randomInts :: Int -> StdGen -> [Int]
randomInts k g = let result = take k (randoms g)
in force result `seq` result
testFunction = parSort
main = do
args <- getArgs
let count | null args = 500000
| otherwise = read (head args)
input <- randomInts count `fmap` getStdGen
start <- getCurrentTime
let sorted = testFunction input
putStrLn $ "Sort list N = " ++ show (length sorted)
end <- getCurrentTime
putStrLn $ show (end `diffUTCTime` start)
I want to get the time to perform parallel sorting on 2, 3 and 4 processor cores less than 1 core.
At the moment, this result I can not achieve.
Here are my program launches:
1. SortList +RTS -N1 -RTS 10000000
time = 41.2 s
2.SortList +RTS -N3 -RTS 10000000
time = 39.55 s
3.SortList +RTS -N4 -RTS 10000000
time = 54.2 s
What can I do?
Update 1:
testFunction = parSort2 60
Here's one idea you can play around with, using Data.Map. For simplicity and performance, I assume substitutivity for the element type, so we can count occurrences rather than storing lists of elements. I'm confident that you can get better results using some fancy array algorithm, but this is simple and (essentially) functional.
When writing a parallel algorithm, we want to minimize the amount of work that must be done sequentially. When sorting a list, there's one thing that we really can't avoid doing sequentially: splitting up the list into pieces for multiple threads to work on. We'd like to get that done with as little effort as possible, and then try to work mostly in parallel from then on.
Let's start with a simple sequential algorithm.
{-# language BangPatterns, TupleSections #-}
import qualified Data.Map.Strict as M
import Data.Map (Map)
import Data.List
import Control.Parallel.Strategies
type Bag a = Map a Int
ssort :: Ord a => [a] -> [a]
ssort xs =
let m = M.fromListWith (+) $ (,1) <$> xs
in concat [replicate c x | (x,c) <- M.toList m]
How can we parallelize this? First, let's break up the list into pieces. There are various ways to do this, none of them great. Assuming a small number of capabilities, I think it's reasonable to let each of them walk the list itself. Feel free to experiment with other approaches.
-- | Every Nth element, including the first
everyNth :: Int -> [a] -> [a]
everyNth n | n <= 0 = error "What you doing?"
everyNth n = go 0 where
go !_ [] = []
go 0 (x : xs) = x : go (n - 1) xs
go k (_ : xs) = go (k - 1) xs
-- | Divide up a list into N pieces fairly. Walking each list in the
-- result will walk the original list.
splatter :: Int -> [a] -> [[a]]
splatter n = map (everyNth n) . take n . tails
Now that we have pieces of list, we spark threads to convert them to bags.
parMakeBags :: Ord a => [[a]] -> Eval [Bag a]
parMakeBags xs =
traverse (rpar . M.fromListWith (+)) $ map (,1) <$> xs
Now we can repeatedly merge pairs of bags until we have just one.
parMergeBags_ :: Ord a => [Bag a] -> Eval (Bag a)
parMergeBags_ [] = pure M.empty
parMergeBags_ [t] = pure t
parMergeBags_ q = parMergeBags_ =<< go q where
go [] = pure []
go [t] = pure [t]
go (t1:t2:ts) = (:) <$> rpar (M.unionWith (+) t1 t2) <*> go ts
But ... there's a problem. In each round of merges, we use only half as many capabilities as we did in the previous one, and perform the final merge with just one capability. Ouch! To fix this, we'll need to parallelize unionWith. Fortunately, this is easy!
import Data.Map.Internal (Map (..), splitLookup, link)
parUnionWith
:: Ord k
=> (v -> v -> v)
-> Int -- Number of threads to spark
-> Map k v
-> Map k v
-> Eval (Map k v)
parUnionWith f n t1 t2 | n <= 1 = rseq $ M.unionWith f t1 t2
parUnionWith _ !_ Tip t2 = rseq t2
parUnionWith _ !_ t1 Tip = rseq t1
parUnionWith f n (Bin _ k1 x1 l1 r1) t2 = case splitLookup k1 t2 of
(l2, mb, r2) -> do
l1l2 <- parEval $ parUnionWith f (n `quot` 2) l1 l2
r1r2 <- parUnionWith f (n `quot` 2) r1 r2
case mb of
Nothing -> rseq $ link k1 x1 l1l2 r1r2
Just x2 -> rseq $ link k1 fx1x2 l1l2 r1r2
where !fx1x2 = f x1 x2
Now we can fully parallelize bag merging:
-- Uses the given number of capabilities per merge, initially,
-- doubling for each round.
parMergeBags :: Ord a => Int -> [Bag a] -> Eval (Bag a)
parMergeBags !_ [] = pure M.empty
parMergeBags !_ [t] = pure t
parMergeBags n q = parMergeBags (n * 2) =<< go q where
go [] = pure []
go [t] = pure [t]
go (t1:t2:ts) = (:) <$> parEval (parUnionWith (+) n t1 t2) <*> go ts
We can then implement a parallel merge like this:
parMerge :: Ord a => [[a]] -> Eval [a]
parMerge xs = do
bags <- parMakeBags xs
-- Why 2 and not one? We only have half as many
-- pairs as we have lists (capabilities we want to use)
-- so we double up.
m <- parMergeBags 2 bags
pure $ concat [replicate c x | (x,c) <- M.toList m]
Putting the pieces together,
parSort :: Ord a => Int -> [a] -> Eval [a]
parSort n = parMerge . splatter n
pSort :: Ord a => Int -> [a] -> [a]
pSort n = runEval . parMerge . splatter n
There's just one sequential piece remaining that we can parallelize: converting the final bag to a list. Is it worth parallelizing? I'm pretty sure that in practice it is not. But let's do it anyway, just for fun! To avoid considerable extra complexity, I'll assume that there aren't large numbers of equal elements; repeated elements in the result will lead to some work (thunks) remaining in the result list.
We'll need a basic partial list spine forcer:
-- | Force the first n conses of a list
walkList :: Int -> [a] -> ()
walkList n _ | n <= 0 = ()
walkList _ [] = ()
walkList n (_:xs) = walkList (n - 1) xs
And now we can convert the bag to a list in parallel chunks without paying for concatenation:
-- | Use up to the given number of threads to convert a bag
-- to a list, appending the final list argument.
parToListPlus :: Int -> Bag k -> [k] -> Eval [k]
parToListPlus n m lst | n <= 1 = do
rseq (walkList (M.size m) res)
pure res
-- Note: the concat and ++ should fuse away when compiling with
-- optimization.
where res = concat [replicate c x | (x,c) <- M.toList m] ++ lst
parToListPlus _ Tip lst = pure lst
parToListPlus n (Bin _ x c l r) lst = do
r' <- parEval $ parToListPlus (n `quot` 2) r lst
res <- parToListPlus (n `quot` 2) l $ replicate c x ++ r'
rseq r' -- make sure the right side is finished
pure res
And then we modify the merger accordingly:
parMerge :: Ord a => Int -> [[a]] -> Eval [a]
parMerge n xs = do
bags <- parMakeBags xs
m <- parMergeBags 2 bags
parToListPlus n m []
Sorry for the title gore (if you can suggest a better, please do). But my problem is that I dont quite understand how to get this do block to work. I have a code that returns the position of 5 in a list of lists. Like such:
findFive :: [[Int]] -> (Int, Int)
findFive rs = do
x <- xPos rs 0
y <- yPos rs 0
return ( (x,y) )
xPos :: [[Int]] -> Int -> Int
xPos (rs:[[]]) n = n
xPos (rs:rss) n | elem 5 rs = n
| otherwise = xPos rss (n+1)
yPos :: [[Int]] -> Int -> Int
yPos (rs:[[]]) n = n
yPos (rs:rss) n | elem 5 rs = n
| otherwise = yPos rss (n+1)
I
But I cant use my do block this way. I can get it to work by doing
findFive :: [[Int]] -> (Int, Int)
findFive xs = ( (xPos xs 0), (yPos (transpose (xs)) 0) )
But that looks kinda ugly.
Also, is there a way to get this to work without sending in 0 to xPos and yPos ?
Why do? There are no monads there. A let..in suffices:
findFive :: [[Int]] -> (Int, Int)
findFive rs = let
x = xPos rs 0
y = yPos rs 0
in (x,y)
Alternatively, use where:
findFive :: [[Int]] -> (Int, Int)
findFive rs = (x, y)
where
x = xPos rs 0
y = yPos rs 0
You can't use a do block this way because in do blocks you have to (1) bind names to the 'contents' of monadic values, and (2) return a value wrapped in the same monadic type as used in (1). In this case the monadic type would be the list. It's appropriate to return a list of (row, column) pairs because that automatically handles both the cases of not finding the number, or finding it multiple times. So we could do something like
import Control.Monad
findFive ::
[[Int]] -> -- ^ a matrix of numbers.
[(Int, Int)] -- ^ the (zero-indexed) rows and columns of the number
-- ^ #5#, if any (otherwise empty list).
findFive xss =
do
(xs, rowIdx) <- xss `zip` [0 ..]
(x, colIdx) <- xs `zip` [0 ..]
guard $ x == 5
return (rowIdx, colIdx)
input :: [[Int]]
input = [[1, 2, 3], [4, 5, 6], [7, 8, 9]]
-- Should print "row: 1, col: 1".
main :: IO ()
main =
forM_ (findFive input) $ \(rowIdx, colIdx) ->
do
putStr "row: "
putStr $ show rowIdx
putStr ", col: "
print colIdx
Let's say pos is defined this way:
pos :: Eq => a -- A value to find
-> [[a]] -- A 2d matrix
-> Maybe Int -- Index of first row containing the value, if any
pos k rows = pos' rows 0
where pos' [] _ = Nothing
pos' (x:xs) n | elem k x = n
| otherwise = pos' xs (n+1)
There are several changes here:
It will work for lists of any type on which equality is defined, not just Int.
It is generalized to find any value k :: a, not just 5.
It can deal with failure to find any row containing k.
With this definition, we could define findFive as
findFive :: [[Int]] -> (Maybe Int, Maybe Int)
findFive xs = (pos 5 xs, pos 5 (transpose xs))
Using Control.Lens, you can factor out the function pos 5 so that it only needs to be written once. Think of over both as a version of map for pairs instead of lists.
import Control.Lens
findFive xs = over both (pos 5) (xs, transpose xs)
Using Control.Arrow, you can factor out the argument xs so that it only needs to be written once.
import Control.Lens
import Control.Arrow
findFive xs = over both (pos 5) ((id &&& transpose) xs)
-- id &&& transpose = \x -> (id x, transpose x)
Once you've done that, you can easily write findFive in point-free style, by composing over both (pos 5) and id &&& transpose:
findFive = over both (pos 5) . (id &&& transpose)
Have the task
I need to implement the function Change, which will take the value and split it into the possible combinations from list of coins(random list)
Example:
coins = [2,3,7]
GHCi> change 7
[[2,2,3],[2,3,2],[3,2,2],[7]]
That's what I did:
coins :: Num a => [a]
coins = [2, 3, 7]
change :: (Ord a, Num a) => a -> [[a]]
change n = uniqEl (filter (\x -> sum x == n) take ()(subsequences (replic' n coins coins)))
replic' n x y | n == 1 = y
| otherwise = replic' (n-1) x (y ++ x)
uniqEl :: Eq a => [a] -> [a]
uniqEl [] = []
uniqEl (x:xs) = if (x `elem` xs) then uniqEl xs else x : (uniqEl xs)
But this code is very slow. Help to make this program more quickly. As part of the job it is said that this task is easily done with the help of generators lists and recursion. Thank you in advance for your help.
import Data.List
change :: [Int] -> Int -> [[Int]]
change _ 0 = []
change coins n = do
x <- [c | c <- coins, c <= n]
if x == n
then return [x]
else do
xs <- change coins (n - x)
-- if (null xs)
-- then return [x]
-- else if x < (head xs)
-- then []
-- else return (x:xs)
return (x:xs)
change' :: Int -> [[Int]]
change' = change [2,3,7]
test7 = change' 7
test6 = change' 6
test5 = change' 5
test4 = change' 4
You're doing a lot of filtering, eleming and so on, and placing a lot of constraints on the data types.
Think of this more as a dynamic problem, that you constantly need to figure out how many ways there are to return change for a total amount.
Once you have found the amount of possibilities for a specific coin, you can remove it from the list.
Here is my proposed solution wrapped up in one function.
In the list comprehension, note that I assign values to the remaining variable, and that these values range from [0,total], with jumps every x, where x is the denomination.
For example, if you had to calculate how many times $0.25 goes into a $2 total, that list comprehension ends up doing:
[countChange 2, countChange 1.75,countChange 1.5, countChange 1.25,...], but also these next iterations of countChange don't include the 0.25 coin - because we just "tested" that.
-- Amount to return -> List of Coin denominations available
countChange :: Integer -> [Integer] -> Integer
countChange _ [] = 0 -- No coins at all, so no change can be given
countChange 0 _ = 1 -- Only one way to return 0 change
countChange total (x:xs) = sum [countChange (total-remaining) xs | remaining <- [0,x..total]]
Use MemoCombinators. This is fast ! Pls. try change 100
import Data.List
import qualified Data.MemoCombinators as Memo
coins :: [Int]
coins = [2,3,7]
change :: Int -> [[Int]]
change = Memo.integral change'
change' 0 = []
change' n = do
x <- [c | c <- coins, c <= n]
if x == n
then return [x]
else do
xs <- change (n - x)
-- if (null xs)
-- then return [x]
-- else if x < (head xs)
-- then []
-- else return (x:xs)
return (x:xs)
I want to make all possible combinations of subgroups with 2 lists. Here is a function that does just this:
getCombinations :: [a] -> [[a]]
getCombinations na = do
a <- na
b <- na
[[a,b]]
If you pass "abc" to this function, it returns this:
["aa","ab","ac","ba","bb","bc","ca","cb","cc"]
A simple modification of the same method could return combinations of 3 lists instead of two.
getCombinations :: [a] -> [[a]]
getCombinations na = do
a <- na
b <- na
c <- na
[[a,b,c]]
Result of passing "abc" as an argument:
["aaa","aab","aac","aba","abb","abc","aca","acb","acc",
"baa","bab","bac","bba","bbb","bbc","bca","bcb","bcc",
"caa","cab","cac","cba","cbb","cbc","cca","ccb","ccc"]
What's the simplest way to make it scale to an arbitrary number of lists? Here is what the type declaration should look like:
getCombinations :: Int -> [a] -> [[a]]
What you want is replicateM:
replicateM :: Int -> m a -> m [a]
The definition is as simple as:
replicateM n = sequence . replicate n
so it's sequence on the list monad that's doing the real work here.
For those come here for the combination function, a k-combination of a set S is a subset of k distinct elements of S, note that the order doesn't matter.
Choose k elements from n elements equals choose k - 1 elements from n - 1 elements plus choose k elements from n - 1 elements.
Use this recursive definition, we can write:
combinations :: Int -> [a] -> [[a]]
combinations k xs = combinations' (length xs) k xs
where combinations' n k' l#(y:ys)
| k' == 0 = [[]]
| k' >= n = [l]
| null l = []
| otherwise = map (y :) (combinations' (n - 1) (k' - 1) ys) ++ combinations' (n - 1) k' ys
ghci> combinations 5 "abcdef"
["abcde","abcdf","abcef","abdef","acdef","bcdef"]
The op's question is a repeated permutations, which someone has already given an answer. For non-repeated permutation, use permutations from Data.List.