I am having trouble with the following exercise:
I must make a function named addDigit, which takes two Int's, the second one being between 0 and 9, and return an Int that is the first Int followed by the second one.
Example:
input: addDigit (-123) 4
output: -1234
what I have tried is the following :
addDigit :: Int -> Int -> Int
addDigit x y = x ++ y
I get it doesn't work because the ++ keyword only works with strings, chars and lists (i think), and this is supposed to be solved in a simple way without changing the Int's to Strings or any sort of other variables, but i have no clue at all on how to do it.
You are trying to solve the problem graphically (thinking of the integers as strings), you want to treat it as a numerical problem. For positive values, appending a digit is accomplished by the following function.
addDigitPositive a b = 10 * a + b
This will unfortunately not work if a < 0. Under those circumstances we would have to subtract b. We can incorporate this functionality easily with function guards.
addDigit a b | a < 0 = a * 10 - b
| otherwise = a * 10 + b
Or you could solve it graphically, by converting the numbers to strings using show and then concatenating them with (++):
addDigit :: Int -> Int -> String
addDigit x y = (show x) ++ (show y)
Now, if you still want an Int as the output, you can convert the string to an Int using read:
addDigit :: Int -> Int -> Int
addDigit x y = read ((show x) ++ (show y))
As you can see, there is more than one way to skin a cat.
I hope this helps.
Related
I'm trying to learn how to use Haskell and now I have to make a program that takes a integer n and a string k and every letter of that string will be moved n places to the right in the alphabet. At this moment I've got the next code:
import Data.Char
main = do
x <- read getLine :: Int
y <- getLine
caesar x y
result :: String
rotate :: Int -> Char -> [Char]
rotate a b = [chr ((a + ord b) `mod` ord 'z' + ord 'a')]
caesar :: Int -> String -> ()
caesar moving text= do
rotatespecific moving text 0
putStrLn result
rotatespecific :: Int -> String -> Int -> ()
rotatespecific moving text place = do
if place < length text
then
result ++ rotate (moving (text !! place))
rotatespecific (moving text (place + 1))
else
if place == length text
then
result ++ rotate (moving (text !! place))
But I can't compile it because it still gives me the same error message:
parse error (possibly incorrect indentation or mismatched brackets)
|
28 | result ++ rotate (moving (text !! place))
| ^
But I can't see what's wrong with my syntax. I first thought it had something to do with using a Char as parameter for my function but I was wrong because text !! place should give a char and not a [char]. So what's wrong with what I'm doing?
After some edit I got this, but it still doesn't work:
import Data.Char
main = do
xr <- getLine
let x = read xr :: Int
y <- getLine
putStrLn (rotatespecific (x y 0))
rotate :: Int -> Char -> [Char]
rotate a b = [chr ((a + ord b) `mod` ord 'z' + ord 'a')]
rotatespecific :: Int -> String -> Int -> String
rotatespecific moving text place = do
if place < length text
then do
help <- text !! place
h <- rotate (moving help)
a <- rotatespecific (moving text (place + 1))
b <- h ++ a
return b
else
if place == length text
then do
return rotate (moving (text !! place))
else
return ()
The immediate problem is that every if must have an else. You got a parse error at the end because the parser is expecting more, namely an else for that if place == length text.
When you fix this you will have more problems, because you are treating Haskell like an imperative language, and that's not how she likes to be treated. It seems like you think
result ++ newstuff
will mutate result, adding newstuff to the end of it. But Haskell doesn't mutate. Instead, this expression result ++ newstuff is the list that results when you concatenate result and newstuff, but result itself remains unchanged.
ghci> let result = [1,2,3]
ghci> result ++ [4,5,6]
[1,2,3,4,5,6]
ghci> result
[1,2,3]
rotatespecific must return the rotated string, rather than trying to mutate it into existence. The only way functions may communicate is by returning results computed from their arguments -– they may not manipulate any "global" state like result. A function that returns () is guaranteed to be useless.
rotatespecific :: Int -> String -> Int -> String
Delete the result "global variable" (which does not mean what you think it means) and focus on defining rotatespecific in a way that it returns the rotated string.
I would also recommend commenting out main and caesar for now until you have rotatespecific compiling and working when you test it in ghci.
I feel like this is an appropriate time to just show an example, because there are a lot of little problems. I'm not going to fix logic bugs, but I've fixed your syntax. Hopefully this gets you unstuck.
rotatespecific :: Int -> String -> Int -> String
rotatespecific moving text place =
if place < length text then
-- use let .. in instead of do/bind (<-) in pure functions.
let help = text !! place
-- multiple arguments are given after the function, no parentheses
h = rotate moving help
-- use parentheses around an argument if it is a complex expression
-- (anything more than a variable name)
a = rotatespecific moving text (place+1)
b = h ++ a
in b
else
if place == length text then
rotate moving (text !! place)
else
undefined -- you must decide what String to return in this case.
After you have this function working as intended, and only then, open this sealed envelope. ♥️
rotatespecific :: Int -> String -> String
rotatespecific moving text = concatMap (rotate moving) text
I am trying to build a function that converts a Decimal(Int) into a Binary number.
Unfortunately other than in java it is not possible to divide an int by two in haskell.
I am very new to functional programming so the problem could be something trivial.
So far I could not find another solution to this problem but
here is my first try :
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = if (mod n 2 == 0) then
do
0:fromDecimal(n/2)
else
do
1:fromDecimal(n/2)
I got an java implementation here which I did before :
public void fromDecimal(int decimal){
for (int i=0;i<values.length;i++){
if(decimal % 2 = 0)
values[i]=true ;
decimal = decimal/ 2;
else {values[i]= false;
} }
}
Hopefully this is going to help to find a solution!
There are some problems with your solution. First of all, I advise not to use do at all, until you understand what do does. Here we do not need do at all.
Unfortunately other than in java it is not possible to divide an int by two in haskell.
It actually is, but the / operator (which is in fact the (/) function), has type (/) :: Fractional a => a -> a -> a. An Int is not Fractional. You can perform integer division with div :: Integral a => a -> a -> a.
So then the code looks like:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = if (mod n 2 == 0) then 0:fromDecimal (div n 2) else 1:fromDecimal (div n 2)
But we can definitely make this more elegant. mod n 2 can only result in two outcomes: 0 and 1, and these are exactly the ones that we use at the left side of the (:) operator.
So we do not need to use an if-then-else at all:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = mod n 2 : fromDecimal (div n 2)
Likely this is still not exactly what you want: here we write the binary value such that the last element, is the most significant one. This function will add a tailing zero, which does not make a semantical difference (due to that order), but it is not elegant either.
We can define an function go that omits this zero, if the given value is not zero, like:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = go n
where go 0 = []
go k = mod k 2 : go (div k 2)
If we however want to write the most significant bit first (so in the same order as we write decimal numbers), then we have to reverse the outcome. We can do this by making use of an accumulator:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = go n []
where go 0 r = r
go k rs = go (div k 2) (mod k 2:rs)
You cannot / integers in Haskell – division is not defined in terms of integral numbers! For integral division use div function, but in your case more suitable would be divMod that comes with mod gratis.
Also, you are going to get reversed output, so you can reverse manually it after that, or use more memory-efficient version with accumulator:
decToBin :: Int -> [Int]
decToBin = go [] where
go acc 0 = acc
go acc n = let (d, m) = n `divMod` 2 in go (m : acc) d
go will give you an empty list for 0. You may add it manually if the list is empty:
decToBin = (\l -> if null l then [0] else l) . go [] where ...
Think through how your algorithm will work. It starts from 2⁰, so it will generate bits backward from how we ordinarily think of them, i.e., least-significant bit first. Your algorithm can represent non-negative binary integers only.
fromDecimal :: Int -> [Int]
fromDecimal d | d < 0 = error "Must be non-negative"
| d == 0 = [0]
| otherwise = reverse (go d)
where go 0 = []
go d = d `rem` 2 : go (d `div` 2)
In Haskell, when we generate a list in reverse, go ahead and do so but then reverse the result at the end. The reason for this is consing up a list (gluing new items at the head with :) has a constant cost and the reverse at the end has a linear cost — but appending with ++ has a quadratic cost.
Common Haskell style is to have a private inner loop named go that the outer function applies when it’s happy with its arguments. The base case is to terminate with the empty list when d reaches zero. Otherwise, we take the current remainder modulo 2 and then proceed with d halved and truncated.
Without the special case for zero, fromDecimal 0 would be the empty list rather than [0].
The binary numbers are usually strings and not really used in calculations.
Strings are also less complicated.
The pattern of binary numbers is like any other. It repeats but at a faster clip.
Only a small set is necessary to generate up to 256 (0-255) binary numbers.
The pattern can systematically be expanded for more.
The starting pattern is 4, 0-3
bd = ["00","01","10","11"]
The function to combine them into larger numbers is
d2b n = head.drop n $ [ d++e++f++g | d <- bd, e <- bd, f <- bd, g <- bd]
d2b 125
"01111101"
If it's not obvious how to expand, then
bd = ["000","001","010","011","100","101","110","111"]
Will give you up to 4096 binary digits (0-4095). All else stays the same.
If it's not obvious, the db2 function uses 4 pairs of binary numbers so 4 of the set. (2^8) - 1 or (2^12) - 1 is how many you get.
By the way, list comprehension are sugar coated do structures.
Generate the above patterns with
[ a++b | a <- ["0","1"], b <- ["0","1"] ]
["00","01","10","11"]
and
[ a++b++c | a <- ["0","1"], b <- ["0","1"], c <- ["0","1"] ]
["000","001","010","011","100","101","110","111"]
More generally, one pattern and one function may serve the purpose
b2 = ["0","1"]
b4 = [ a++b++c++d | a <- b2, b <- b2, c <- b2, d <- b2]
b4
["0000","0001","0010","0011","0100","0101","0110","0111","1000","1001","1010","1011","1100","1101","1110","1111"]
bb n = head.drop n $ [ a++b++c++d | a <- b4, b <- b4, c <- b4, d <- b4]
bb 32768
"1000000000000000"
bb 65535
"1111111111111111"
To calculate binary from decimal directly in Haskell using subtraction
cvtd n (x:xs) | x>n = 0:(cvtd n xs)
| n>x = 1:(cvtd (n-x) xs)
| True = 1:[0|f<-xs]
Use any number of bits you want, for example 10 bits.
cvtd 639 [2^e|e<-[9,8..0]]
[1,0,0,1,1,1,1,1,1,1]
import Data.List
dec2bin x =
reverse $ binstr $ unfoldr ndiv x
where
binstr = map (\x -> "01" !! x)
exch (a,b) = (b,a)
ndiv n =
case n of
0 -> Nothing
_ -> Just $ exch $ divMod n 2
I understand that Haskell tries to do something more beneficial than simply throwing an error when one does division by zero
test :: Int -> Int -> String
test a b = case a/b of
Infinity -> "fool"
x -> Show x
However i was told my ghc that Infinity is not a data constructor. What is it actually and how can i make use of it? I don't want to simply check b for 0
There are a handful of ways to do this. My preferred one would be to use isInfinite from the Prelude:
test :: Int -> Int -> String
test a b = case fromIntegral a / fromIntegral b of
x | isInfinite x && x > 0 -> "fool"
| otherwise -> show x
Alternately, you could define infinity as in this question and compare for equality (since Infinity == Infinity).
Your code also had a couple of issues I assume are unrelated to your question:
Show should be show
(/) doesn't work for Int arguments, so you need to use fromIntegral to convert a and b to something floating
I also suspect you aware this particular function doesn't require an infinity check...
test :: Int -> Int -> String
test a 0 | a > 0 = "fool"
| otherwise = show (fromIntegral a / fromIntegral b)
I use recursion to compare two numbers(ex 123 is the same with 123) and store how many digits they have in common(ex 123 compared to 123 has 3 and with 124 has 2).
While my program does find that number i want to put conditions for every situation (ex if they have 2 digits in common output value 44 or if they have 3 do something else etc.) but no comparison is done. Can someone please explain to me what and why that happens. Here my code :
dg :: Int->Int->Int
dg 0 0 = 0
dg x y = if (c==2) then 23 else 24 -- c = common digits
where c = digits (x `div` 10) (y `div` 10) + if (x `mod` 10 == y `mod` 10) then 1 else 0
I run hugs deleting the "if" condition, giving input 10 10 the output is 2 but when i leave it on and rerun it, it goes to 24 (while 23 is correct). I'm really confused.
To find how many digits two Int have in common, using the string representation isn't too bad (It's actually terrible, see update below).
commonDigits :: Int -> Int -> Int
commonDigits a b = length . filter id $ zipWith (==) (reverse $ show a) (reverse $ show b)
reverse is needed to make sure the digits align properly.
If you're into point-free style:
import Data.Function
commonDigits :: Int -> Int -> Int
commonDigits = fmap (length . filter id) . zipWith (==) `on` reverse . show
Then if you want to return a special Int depending on the result of commonDigits you can use a separate function:
specialResult :: Int -> Int -> Int
specialResult a b =
case commonDigits a b of
2 -> 23
3 -> 48
_ -> 256
Update: For negative integers this method is not good. If only one of the argument is negative this function should behave like your mod 10 version. If both are negative there is the possibility that the '-' sign is counted as a digit.
Let's use a digits function that will give a list of digits for both positive and negative numbers from the least significant to the most significant digits. What happens if the number 0 is given as input, should we return an empty list or [0]? Your call on that one, but I'm going to assume you want [0].
digits :: Int -> [Int]
digits 0 = [0]
digits n = digits' (abs n)
where
digits' 0 = []
digits' n = n `mod` 10 : digits' (n `div` 10)
With this new digits function we can rewrite commonDigits to:
commonDigits :: Int -> Int -> Int
commonDigits = fmap (length . filter id) . zipWith (==) `on` digits
Here is my first Haskell program. What parts would you write in a better way?
-- Multiplication table
-- Returns n*n multiplication table in base b
import Text.Printf
import Data.List
import Data.Char
-- Returns n*n multiplication table in base b
mulTable :: Int -> Int -> String
mulTable n b = foldl (++) (verticalHeader n b w) (map (line n b w) [0..n])
where
lo = 2* (logBase (fromIntegral b) (fromIntegral n))
w = 1+fromInteger (floor lo)
verticalHeader :: Int -> Int -> Int -> String
verticalHeader n b w = (foldl (++) tableHeader columnHeaders)
++ "\n"
++ minusSignLine
++ "\n"
where
tableHeader = replicate (w+2) ' '
columnHeaders = map (horizontalHeader b w) [0..n]
minusSignLine = concat ( replicate ((w+1)* (n+2)) "-" )
horizontalHeader :: Int -> Int -> Int -> String
horizontalHeader b w i = format i b w
line :: Int -> Int -> Int -> Int -> String
line n b w y = (foldl (++) ((format y b w) ++ "|" )
(map (element b w y) [0..n])) ++ "\n"
element :: Int -> Int -> Int -> Int -> String
element b w y x = format (y * x) b w
toBase :: Int -> Int -> [Int]
toBase b v = toBase' [] v where
toBase' a 0 = a
toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b
toAlphaDigits :: [Int] -> String
toAlphaDigits = map convert where
convert n | n < 10 = chr (n + ord '0')
| otherwise = chr (n + ord 'a' - 10)
format :: Int -> Int -> Int -> String
format v b w = concat spaces ++ digits ++ " "
where
digits = if v == 0
then "0"
else toAlphaDigits ( toBase b v )
l = length digits
spaceCount = if (l > w) then 0 else (w-l)
spaces = replicate spaceCount " "
Here are some suggestions:
To make the tabularity of the computation more obvious, I would pass the list [0..n] to the line function rather than passing n.
I would further split out the computation of the horizontal and vertical axes so that they are passed as arguments to mulTable rather than computed there.
Haskell is higher-order, and almost none of the computation has to do with multiplication. So I would change the name of mulTable to binopTable and pass the actual multiplication in as a parameter.
Finally, the formatting of individual numbers is repetitious. Why not pass \x -> format x b w as a parameter, eliminating the need for b and w?
The net effect of the changes I am suggesting is that you build a general higher-order function for creating tables for binary operators. Its type becomes something like
binopTable :: (i -> String) -> (i -> i -> i) -> [i] -> [i] -> String
and you wind up with a much more reusable function—for example, Boolean truth tables should be a piece of cake.
Higher-order and reusable is the Haskell Way.
You don't use anything from import Text.Printf.
Stylistically, you use more parentheses than necessary. Haskellers tend to find code more readable when it's cleaned of extraneous stuff like that. Instead of something like h x = f (g x), write h = f . g.
Nothing here really requires Int; (Integral a) => a ought to do.
foldl (++) x xs == concat $ x : xs: I trust the built-in concat to work better than your implementation.
Also, you should prefer foldr when the function is lazy in its second argument, as (++) is – because Haskell is lazy, this reduces stack space (and also works on infinite lists).
Also, unwords and unlines are shortcuts for intercalate " " and concat . map (++ "\n") respectively, i.e. "join with spaces" and "join with newlines (plus trailing newline)"; you can replace a couple things by those.
Unless you use big numbers, w = length $ takeWhile (<= n) $ iterate (* b) 1 is probably faster. Or, in the case of a lazy programmer, let w = length $ toBase b n.
concat ( (replicate ((w+1)* (n+2)) "-" ) == replicate ((w+1) * (n+2)) '-' – not sure how you missed this one, you got it right just a couple lines up.
You do the same thing with concat spaces, too. However, wouldn't it be easier to actually use the Text.Printf import and write printf "%*s " w digits?
Norman Ramsey gave excellent high-level (design) suggestions; Below are some low-level ones:
First, consult with HLint. HLint is a friendly program that gives you rudimentary advice on how to improve your Haskell code!
In your case HLint gives 7 suggestions. (mostly about redundant brackets)
Modify your code according to HLint's suggestions until it likes what you feed it.
More HLint-like stuff:
concat (replicate i "-"). Why not replicate i '-'?
Consult with Hoogle whenever there is reason to believe that a function you need is already available in Haskell's libraries. Haskell comes with tons of useful functions so Hoogle should come in handy quite often.
Need to concatenate strings? Search for [String] -> String, and voila you found concat. Now go replace all those folds.
The previous search also suggested unlines. Actually, this even better suits your needs. It's magic!
Optional: pause and thank in your heart to Neil M for making Hoogle and HLint, and thank others for making other good stuff like Haskell, bridges, tennis balls, and sanitation.
Now, for every function that takes several arguments of the same type, make it clear which means what, by giving them descriptive names. This is better than comments, but you can still use both.
So
-- Returns n*n multiplication table in base b
mulTable :: Int -> Int -> String
mulTable n b =
becomes
mulTable :: Int -> Int -> String
mulTable size base =
To soften the extra characters blow of the previous suggestion: When a function is only used once, and is not very useful by itself, put it inside its caller's scope in its where clause, where it could use the callers' variables, saving you the need to pass everything to it.
So
line :: Int -> Int -> Int -> Int -> String
line n b w y =
concat
$ format y b w
: "|"
: map (element b w y) [0 .. n]
element :: Int -> Int -> Int -> Int -> String
element b w y x = format (y * x) b w
becomes
line :: Int -> Int -> Int -> Int -> String
line n b w y =
concat
$ format y b w
: "|"
: map element [0 .. n]
where
element x = format (y * x) b w
You can even move line into mulTable's where clause; imho, you should.
If you find a where clause nested inside another where clause troubling, then I suggest to change your indentation habits. My recommendation is to use consistent indentation of always 2 or always 4 spaces. Then you can easily see, everywhere, where the where in the other where is at. ok
Below's what it looks like (with a few other changes in style):
import Data.List
import Data.Char
mulTable :: Int -> Int -> String
mulTable size base =
unlines $
[ vertHeaders
, minusSignsLine
] ++ map line [0 .. size]
where
vertHeaders =
concat
$ replicate (cellWidth + 2) ' '
: map horizontalHeader [0 .. size]
horizontalHeader i = format i base cellWidth
minusSignsLine = replicate ((cellWidth + 1) * (size + 2)) '-'
cellWidth = length $ toBase base (size * size)
line y =
concat
$ format y base cellWidth
: "|"
: map element [0 .. size]
where
element x = format (y * x) base cellWidth
toBase :: Integral i => i -> i -> [i]
toBase base
= reverse
. map (`mod` base)
. takeWhile (> 0)
. iterate (`div` base)
toAlphaDigit :: Int -> Char
toAlphaDigit n
| n < 10 = chr (n + ord '0')
| otherwise = chr (n + ord 'a' - 10)
format :: Int -> Int -> Int -> String
format v b w =
spaces ++ digits ++ " "
where
digits
| v == 0 = "0"
| otherwise = map toAlphaDigit (toBase b v)
spaces = replicate (w - length digits) ' '
0) add a main function :-) at least rudimentary
import System.Environment (getArgs)
import Control.Monad (liftM)
main :: IO ()
main = do
args <- liftM (map read) $ getArgs
case args of
(n:b:_) -> putStrLn $ mulTable n b
_ -> putStrLn "usage: nntable n base"
1) run ghc or runhaskell with -Wall; run through hlint.
While hlint doesn't suggest anything special here (only some redundant brackets), ghc will tell you that you don't actually need Text.Printf here...
2) try running it with base = 1 or base = 0 or base = -1
If you want multiline comments use:
{- A multiline
comment -}
Also, never use foldl, use foldl' instead, in cases where you are dealing with large lists which must be folded. It is more memory efficient.
A brief comments saying what each function does, its arguments and return value, is always good. I had to read the code pretty carefully to fully make sense of it.
Some would say if you do that, explicit type signatures may not be required. That's an aesthetic question, I don't have a strong opinion on it.
One minor caveat: if you do remove the type signatures, you'll automatically get the polymorphic Integral support ephemient mentioned, but you will still need one around toAlphaDigits because of the infamous "monomorphism restriction."