I am trying to print Pascals triangle up to some arbitrary row, after some thought I came up with this solution:
next xs = zipWith (+) ([0] ++ xs) (xs ++ [0])
pascal n = take n (iterate next [1])
main = do
n <- readLn :: IO Int
mapM_ putStrLn $ map show $ pascal n
Which works quite well, except for the printing. When I apply pascal 4 I get:
[1]
[1,1]
[1,2,1]
[1,3,3,1]
When what I really want is this:
1
1 1
1 2 1
1 3 3 1
Is there any way I can do this?
Define your own pretty-printing function:
import Data.List (intercalate)
show' :: Show a => [a] -> String
show' = intercalate " " . map show
You could unwords / unlines:
import Data.List
...
putStr $ unlines $ map (unwords . map show) $ pascal n
Related
So I'm trying to make a function "rot" which takes a string and returns a list of strings with all possible rotations, e.g rot "abc" returns ["abc", "bca", cab"], seems very simple to do in other languages but I'm a newbie at haskell so I can't think of a way to do it. This is what I have so far:
rot :: [Char] -> [[Char]]
rot word =
let
lst = [tail word ++ [head word]]
in
lst
main = do
print(rot "abc")
It returns me "bca" as expected, but I would like a way to find all rotations and store it in a list.
Here's an example in python
def rot(word):
lst = []
for i in range(len(word)):
newWord1 = word[0:i]
newWord2 = word[i:]
newWordResult = newWord2 + newWord1
lst.append(newWordResult)
return lst
Well, you can more or less directly translate your Python code. Recursion is customarily used in functional programming instead of iteration, and it's more convenient to count from length word down to zero. Other than that, it's pretty much the same:
rot word =
let loop 0 lst = lst
loop i lst =
let newWord1 = take (i-1) word
newWord2 = drop (i-1) word
newWordResult = newWord2 ++ newWord1
in loop (i-1) (newWordResult : lst)
in loop (length word) []
One can make use of the tails and inits of a list:
Prelude Data.List> tails "abc"
["abc","bc","c",""]
Prelude Data.List> inits "abc"
["","a","ab","abc"]
we thus can use this with:
import Data.List(inits, tails)
rotated :: [a] -> [[a]]
rotated xs = [x ++ y | (x#(_:_), y) <- zip (tails xs) (inits xs)]
This produces:
Prelude Data.List> rotated "abc"
["abc","bca","cab"]
Prelude Data.List> rotated [1,4,2,5]
[[1,4,2,5],[4,2,5,1],[2,5,1,4],[5,1,4,2]]
Prelude Data.List> rotated [1.0,3.0,0.0,2.0]
[[1.0,3.0,0.0,2.0],[3.0,0.0,2.0,1.0],[0.0,2.0,1.0,3.0],[2.0,1.0,3.0,0.0]]
or as #Iceland_jack says, we can use the ParallelListComp extension to allow iterating over two lists in parallel in list comprehension without the explicit use of zip:
{-# LANGUAGE ParallelListComp #-}
import Data.List(inits, tails)
rotated :: [a] -> [[a]]
rotated xs = [x ++ y | x#(_:_) <- tails xs | y <- inits xs]
This is, simply,
rotations xs = map (take n) . take n
. tails $ xs ++ xs
where
n = length xs
It is customary to avoid length if at all possible, though here it leads to a bit more convoluted code(*) (but more often than not it leads to a simpler, cleaner code that is more true to the true nature of the problem),
rotations2 xs = map (zipWith (\a b -> b) xs)
. zipWith (\a b -> b) xs
. tails $ xs ++ xs
Testing, we get
> rotations "abcd"
["abcd","bcda","cdab","dabc"]
> rotations2 "abcd"
["abcd","bcda","cdab","dabc"]
> take 4 . map (take 4) $ rotations2 [1..]
[[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6,7]]
(*) edit Actually, it probably merits its own name,
takeLength :: [a] -> [b] -> [b]
takeLength = zipWith (\a b -> b)
rotations2 xs = map (takeLength xs)
. takeLength xs
. tails $ xs ++ xs
I tried solving this, and the following is trial stuff.
When I test this in ghci with hSetBuffering stdout NoBuffering, solveAct 1, 15 10, ghci showed few lines of results and blocked much time, and showed rest result at once.
How can I see the intermediate results in real time?
import Control.Monad
import Data.List
import Data.Maybe
import System.IO
readInts = fmap read . words <$> getLine :: IO [Int]
main = do
t <- readLn :: IO Int
hSetBuffering stdout NoBuffering
sequence_ $ solveAct <$> [1..t]
showTable x = intercalate "\n" $ intercalate " " . fmap show <$> x
solveAct i = do
[j, n] <- readInts
putStrLn $ "Case #" ++ show i ++ ":"
putStrLn $ showTable (take n $ solve (j-1))
digits n = [[x ^ y | y <- [1..n-1]] | x <- [2..10]]
primes = 2 : [x | x <- [3,5..], all (\y -> x `rem` y /= 0) $ takeWhile (<= intSqrt x) primes]
intSqrt = floor . sqrt . fromIntegral
getNDivisor n = listToMaybe [x | x <- takeWhile (<= intSqrt n) primes, n `rem` x == 0]
casesOfMat = subsequences . transpose . digits
casesOfJam n = fmap ([1 + x^n | x <- [2..10]]:) $ casesOfMat n
eachBaseReps n = fmap sum . transpose <$> casesOfJam n
solve :: Int -> [[Int]]
solve n = do
decimals <- eachBaseReps n
let divs = getNDivisor <$> decimals
guard $ all isJust divs
return $ last decimals : catMaybes divs
You are seeing the results in real time. It's just that the computation of all isJust . map getNDivisor takes a long time for the third element of eachBaseReps 14.
i have a list of tuples like:
[("3",69.46),("4",38.32),("5",111.67),("9",97.13)]
and i want to print this list of tuple like :
3 69.46
4 38.32
5 111.67
9 97.13
What is the best way to implement this?
(The length of list is dynamic)
Thanks
One way would be like this:
printList xs = mapM_ (\(a,b) -> putStr a >> putStr (" " ++ show b) >> putStrLn "") xs
Or in a more readable way:
printList xs = mapM_ (\(a,b) -> do
putStr a
putStr (" " ++ show b)
putStrLn "") xs
Or as #icktoofay points out you can use a single putStrLn:
printList xs = mapM_ (\(a,b) -> putStrLn $ a ++ " " ++ show b) xs
In ghci:
λ> printList [("3",69.46),("4",38.32),("5",111.67),("9",97.13)]
3 69.46
4 38.32
5 111.67
9 97.13
I have a problem with built a function with a monad-list
> multab 4
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
So I want to start like :
multab :: Integer -> [String]
for the rest, would you like give any suggestions?
Thanks in advance.
Basically you want to generate a list of entries and then print them.
Let's start with the entries. These consists of two integers and their product. So let us define a type synonym to hold the two integers
type Entry = (Integer, Integer)
and an evaluation function that computes the product of these integers,
eval :: Entry -> Integer
eval = uncurry (*)
Then, we define a function for generating the entries:
gen :: Integer -> [Entry]
gen n = [(i, j) | i <- [1 .. n], j <- [i .. n]]
For example:
> gen 4
[(1,1),(1,2),(1,3),(1,4),(2,2),(2,3),(2,4),(3,3),(3,4),(4,4)]
Next, we need to be able to print an entry:
showEntry :: Entry -> String
showEntry e#(i, j) = show i ++ "*" ++ show j ++ "=" ++ show (eval e)
For example:
> showEntry (2, 3)
"2*3=6"
Finally, let's glue these pieces together:
multab :: Integer -> [String]
multab = map showEntry . gen
Here we go:
> multab 4
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
Here is some scratch solution based on Karolis answer.
> let nonDec xs = and $ zipWith (>=) (drop 1 xs) xs
nonDec :: Ord b => [b] -> Bool
> let getSets s n = filter nonDec $ replicateM n s
getSets :: Ord b => [b] -> Int -> [[b]]
> getSets [1,2,3,4] 2
[[1,1],[1,2],[1,3],[1,4],[2,2],[2,3],[2,4],[3,3],[3,4],[4,4]]
> let showExp = \[i,j] -> show i ++ "*" ++ show j ++ "=" ++ show (i*j)
showExp :: [Integer] -> [Char]
> map showExp $ getSets [1,2,3,4] 2
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
So, multab is \n -> map showExp $ getSets [1..n] 2.
The natural way to do this is to generate a list of all pairs (i, j) with i < or = j and then map (\(i, j) -> show i ++ "*" ++ show j ++ "=" ++ show (i*j)) on it. The most obvious way to generate such list would be to write [(i, j) | i <- [1..n], j <- [1..n], i <= j]. Although it might be better to do [1..n] >>= list where list i = map (\k -> (i, k)) [i..n] as this does not do any filtering (because it doesn't generate unwanted pairs).
Just as an alternative to the other answers one which uses the List as a Monad.
multab :: Integer -> [String]
multab n = do
i <- [1..n]
j <- [i..n]
return $ show i ++ "*" ++ show j ++ "=" ++ show (i*j)
Where the first two rules bind every pair of integers (i,j) with j <= i <= n. The last rule returns the printed value.
More practical is perhaps the list comprehension version
multab2 :: Integer -> [String]
multab2 n =
[ show i ++ "*" ++ show j ++ "=" ++ show (i*j)
| i <- [1..n]
, j <- [i..n] ]
Which could be directly translated to the monad version as the structure suggests, though this is not the most efficient translation. Additionally this is equivalent to what you would get when you inline all the functions from dblhelix's answer.
I am doing yet another Project Euler problem - Problem 38.
I have this function which returns a list of numbers but what I need is that list of numbers to be one number. It calculates the concatenated product of an integer.
f (a,b) = a*b
conProInt x n = map f (zip (replicate n x) ([1..n]))
prob38 = maximum [ (conProInt (x) (n)) | x <- [100..500], n <- [1..9], (sort $ nub $ (decToList $ (conProInt x n) )) == (sort $ (decToList $ (conProInt x n) )), (sort $ nub $ (decToList $ (conProInt x n))) == [1..9] ]
eg:
conProInt 192 3
returns:
[192,384,576]
what I need returned is:
192384576
I have searched around and can't find a function or think of a function I could construct that would deliver what I need. How would I go about this?
EDIT:
I have updated the script to incorporate faster concatenation, but it doesn't return the correct result:
f (a,b) = a*b
conProInt x n =( combine (map f (zip (replicate n x) ([1..n]))))
prob38 = maximum [ (conProInt (x) (n)) | x <- [1..50000], n <- [2..40], (sort $ nub $ (decToList $ (conProInt x n) )) == (sort $ (decToList $ (conProInt x n) )), (sort $ nub $ (decToList $ (conProInt x n))) == [1..9] ]
I'm pretty sure the pandigital test
(sort $ nub $ (decToList $ (conProInt x n) )) == (sort $ (decToList $ (conProInt x n) )), (sort $ nub $ (decToList $ (conProInt x n))) == [1..9]
won't fail. I tried to make the search as large as possible, but the maximum 9-pandigital I got was 986315724. Any suggestions? Is the range of values for n a very large one?
Going via Strings is probably easiest:
read $ concat $ map (show) [192,384,576]
Though you'll probably need to add a type signature:
Prelude> (read $ concat $ map (show) [192,384,576]) :: Int
192384576
You can use this function to concatenate a list of numbers:
concatNumbers :: [Int] -> String
concatNumbers = concat . map show
If you want the function to return the concatenation as a number, you can use read.
Here's an example of how to concatenate digits without converting to and from character strings.
-- foldl1' is a strict fold. "foldl1" would also work...
import Data.List (foldl1')
-- Combine two numbers such that their digits are concatenated.
-- op 1 23 = 123, op 0 12 = 12, op 12345 67 = 1234567
op :: Int -> Int -> Int
op a b = a * power 10 (numDigits b) + b
-- How many digits does a positive number have?
numDigits :: Int -> Int
numDigits x = length . takeWhile (>= 1) . iterate (`div` 10) $ x
-- Take a positive number and raise it to a positive power.
-- power 5 2 = 25, power 10 3 = 1000
power :: Int -> Int -> Int
power x y = foldl1' (*) . take y $ repeat x
-- Take a list of numbers, and concatenate all their digits.
combine :: [Int] -> Int
combine xs = foldl1' op xs
example run:
Prelude> :m +Data.List
Prelude Data.List> let power x y = foldl1' (*) . take y $ repeat x
Prelude Data.List> let numDigits = length . takeWhile (>=1) . iterate (`div` 10)
Prelude Data.List> let op a b = a * power 10 (numDigits b) + b
Prelude Data.List> let combine xs = foldl1' op xs
Prelude Data.List> combine [192, 384, 576]
192384576
Prelude Data.List>