I created a binary search tree and tried to print the binary search tree with this instance
data Tree a = Nil | Node (Tree a) a (Tree a)
instance Show a => Show (Tree a) where
show t = intercalate "\n" (map snd (draw t))
draw :: Show a => Tree a -> [(Int,String)]
draw Nil = [(1,"*")]
draw (Node Nil x Nil) = [(1,show x)]
draw (Node tl x tr) = zip (repeat 0) (map shiftl (draw tl)) ++ [(1,show x ++ "-+")] ++ zip (repeat 2) (map shiftr (draw tr)) where
shiftl (0,x) = spaces ++ " " ++ x
shiftl (1,x) = spaces ++ "+-" ++ x
shiftl (2,x) = spaces ++ "| " ++ x
shiftr (0,x) = spaces ++ "| " ++ x
shiftr (1,x) = spaces ++ "+-" ++ x
shiftr (2,x) = spaces ++ " " ++ x
spaces = replicate (length (show x)+1) ' '
createTree :: [a] -> BTree a
createTree [] = Nil
createTree xs = Node
(createTree front) x (createTree back) where
n = length xs
(front, x:back) = splitAt (n `div` 2) xs
Now I want to print it horizontally, which i am not able to do so. I want to print the binary search tree like this picture below. (Sorry for the low quality of the picture but you get the idea). How can i do it ?
Use the sample example [1..50]
UPDATE ANSWER :-
I found my answer myself. I created one function that shows like that. The code is in the comments.
If you have an other solution please share
Here's my solution. It's might not be perfect. It prints Nil nodes as a *.
The basic idea is to first get the visualizations of the left and right trees as two lists of strings. Then they are zipped using concatenation to produce a list of strings representing the two trees side-by-side.
instance Show a => Show (Tree a) where
show tree =
let (s, _) = show' tree
in intercalate "\n" s
where
show' :: Show a => Tree a -> ([String], Int)
show' Nil = (["*"], 0)
show' (Node ltree value rtree) = (ashow, acenter)
where
-- middle_padding_length = 1
-- middle_padding = replicate (2*middle_padding_length+1) ' '
middle_padding = " "
pwidth = length middle_padding
lshow, rshow :: [String]
lcenter, rcenter :: Int
(lshow, lcenter) = show' ltree
(rshow, rcenter) = show' rtree
lwidth, rwidth :: Int
lwidth = length (head lshow)
rwidth = length (head rshow)
awidth, acenter :: Int
awidth = lwidth + length middle_padding + rwidth
acenter = lwidth + pwidth `div` 2
-- Put subtrees side by side with some padding
sshow :: [String]
sshow =
zipWith (\s1 s2 -> s1 ++ middle_padding ++ s2)
(extend_depth lwidth lshow)
(extend_depth rwidth rshow)
where
extend_depth twidth tshow =
let
sdepth = max (length lshow) (length rshow)
in
tshow ++ replicate (sdepth - length tshow) (replicate twidth ' ')
vshow :: String
vshow =
let
text = show value
textWidth = length text
whitespaceWidth = awidth - textWidth
leftPadding = acenter - textWidth `div` 2
rightPadding = whitespaceWidth - leftPadding
in
replicate leftPadding ' ' ++ text ++ replicate rightPadding ' '
row :: [Char] -> String
row [lc, mc, rc, hc, sc] =
replicate lcenter sc ++ [lc] ++ replicate (acenter-lcenter-1) hc ++
[mc] ++
replicate (lwidth+pwidth+rcenter-acenter-1) hc ++ [rc] ++ replicate (awidth-lwidth-pwidth-rcenter-1) sc
row _ = error "incorrect number of characters"
two_pipes, splitter, one_pipe :: String
two_pipes = row "| | "
splitter = row "/^\\- "
one_pipe = row " | "
ashow :: [String]
ashow =
vshow :
one_pipe :
splitter :
two_pipes :
sshow
Output for createTree [0..10]:
I found my answer myself. I created one function that shows like that. Here is the code
import Data.List (intercalate)
data BTree a = Nil | Node (BTree a) a (BTree a) deriving Eq
-- Instances of BST
instance Show a => Show (BTree a) where
show t = "\n" ++ intercalate "\n" (map (map snd) (fst $ draw5 t)) ++ "\n"
-- End of instances
data Tag = L | M | R deriving (Eq,Show)
type Entry = (Tag, Char)
type Line = [Entry]
--the tag thing is for my own understanding that do no work here.
createTree :: [a] -> BTree a
createTree [] = Nil
createTree xs = Node
(createTree front) x (createTree back) where
n = length xs
(front, x:back) = splitAt (n `div` 2) xs
-- my own draw
draw5 :: Show a => BTree a -> ([Line],(Int,Int,Int))
draw5 Nil = ([zip [M] "*"],(0,1,0) )
draw5 (Node Nil x Nil) =
let (sx,n,m) = (show x, length sx, n `div` 2) in
([zip (replicate m L ++ [M] ++ replicate (n-m-1) R) sx], (m,1,n-m-1))
draw5 (Node tl x tr) = (l1:l2:l3:l4:mainline,(a,b,c)) where
(mainline ,(a,b,c)) = drawing xs ys
(xs,(xsa,xsb,xsc)) = draw5 tl
(ys,(ysa,ysb,ysc)) = draw5 tr
drawing xs ys = (join xs ys, (xsa+xsb+xsc+1, 1, ysa+ysb+ysc+1) )
join (as:ass) (bs:bss) = go as bs : join ass bss
join xss [] = map (++ ([(L,' '),(M, ' '),(R,' ')] ++ replicate (ysa+ysb+ysc) (R,' ') )) xss
join [] yss = map ((replicate (xsa+xsb+xsc) (L,' ') ++ [(L,' '),(M, ' '),(R,' ')]) ++ ) yss
go xss yss = xss ++ [(L,' '),(M, ' '),(R,' ')] ++ yss
([cs],(m,n,o)) = draw5 (Node Nil x Nil)
l1 = replicate (a-m) (L,' ') ++ cs ++ replicate (c-o) (R,' ')
l2 = replicate a (L,' ') ++ [(M, '|')] ++ replicate c (R,' ')
l3 = replicate xsa (L,' ') ++ [(L,'+')] ++ replicate (xsc+1) (L,'-') ++ [(M,'+')] ++ replicate (ysa+1) (R,'-') ++ [(R,'+')] ++ replicate ysc (R,' ')
l4 = replicate xsa (L,' ') ++ [(L,'|')] ++ replicate (xsc+ysa+3) (M,' ') ++ [(R,'|')] ++ replicate ysc (R,' ')
Define a function nohundred :: Int -> Int such that for a positive number n nohundred n is the nth positive number such that "100" does not occur as a substring in its binary expansion.
decToBin :: Int -> [Int]
decToBin x = reverse $ decToBin' x
where
decToBin' :: Int -> [Int]
decToBin' 0 = []
decToBin' y = let (a,b) = quotRem y 2 in [b] ++ decToBin' a
check :: [Int] -> Bool
check (z:zs)
|((z == 1) && (head (zs) == 0) && (head (tail zs) == 0)) = True
| otherwise = check zs
binToDec :: [Int] -> Int
binToDec l = sumlist (zipWith (*) (iterate f 1) (reverse l))
where
sumlist :: [Int] -> Int
sumlist [] = 0
sumlist (x:xs) = x + (sumlist xs)
f :: Int -> Int
f j = (2 * j)
nohundred :: Int -> Int
nohundred n = if ((check fun) == True) then (binToDec (fun)) else (nohundred (n+1))
where
fun = decToBin n
The above code gives error :-
*Main> nohundred 10
*** Exception: Prelude.head: empty list...
The desired output is 14.
*Main> nohundred 100
100
The desired output is 367...
Can anyone suggest the cause of error?
This function is partial:
check (z:zs)
|((z == 1) && (head (zs) == 0) && (head (tail zs) == 0)) = True
| otherwise = check zs
When called with a one- or two-element list, the first check will call head on an empty list. Additionally, it does not cover the empty-list case. The idiomatic way to write this is:
check (1:0:0:zs) = True
check (z:zs) = check zs
check [] = False
Additionally, your nohundred function takes a number and finds the next higher non-hundred number; but you want the nth non-hundred number, which is a very different thing.
Because of the fact I am a beginner when it comes to Haskell and generally functional programmer I would like to someone tell me how to improve my solution. The task is convert string to ints. For example:
"sada21321" -> []
"d123 32 4 123.3 32 " -> [32, 4, 32]
"FFFFFFFFFF" -> []
" " -> []
Solution:
import Data.Char
readInts :: String -> [Int]
readInts s = (( map convertStringToInt ) . (filter (\ elem -> (all isDigit elem))) . getSubstrings)s
getSubstrings :: String -> [String]
getSubstrings s = getSubstrings' s [] [] where
getSubstrings' (h:t) curr res
| h == ' ' && (length curr ) > 0 = getSubstrings' t [] ( res ++ [curr])
| h /= ' ' = getSubstrings' t (curr ++ [h]) res
| otherwise = getSubstrings' t curr res
getSubstrings' [] curr res = if (length curr ) > 0 then ( res ++ [curr] ) else res
reverseList :: [a] -> [a]
reverseList [] = []
reverseList (h:t) = (reverseList t) ++ [h]
convertStringToInt :: String -> Int
convertStringToInt s = convertStringToInt' (reverseList s) 1 0
where
convertStringToInt' [] _ res = res
convertStringToInt' (h:t) m res = convertStringToInt' t (m*10) (res + (((ord h) - 48)*m))
You should take a look at the words and read functions.
(because this is an assignment, I'll let you fill in the details)
Use read ("Your string here.") :: Integer and also check for read. You can convert string to mostly any types you want to.
imP:: Int -> IO String
imP n = do
x <- getLine
if n >= 0 then return ( (concat (replicate n " ")) ++ fun1 x) else return ( fun2 n x)
where
fun1 [] = ""
fun1 (x:xs)
| isAlpha x = [x] ++ fun1 xs
| otherwise = "\n" ++ fun1 xs
fun2 n [] = ""
fun2 n (x:xs)
| isAlpha x = [x] ++ fun2 n xs
| otherwise = "\n" ++ (concat (replicate (abs n) " ")) ++ fun2 n xs
I have this code. And given an input "hello3mello" to getLine it returns:
"hello\nmello"
But I need:
"hello
mello"
EDIT:
<interactive>:32:9:
Couldn't match type `IO String' with `[Char]'
Expected type: String
Actual type: IO String
In the first argument of `putStr', namely `(imP 3)'
In the expression: putStr (imP 3)
The type of putStr is String -> IO (), you can't apply it to imP 3 :: IO String because putStr expects a pure String not an IO String. Which is exactly what GHC's error message is reporting.
I assume you're not familiar with monads, so I'd recommend reading any of the many tutorials. In the meantime, use \x -> imP x >>= putStr
How I can make here filter (x:xs) = (x, length (x:xs)) that puts length when length > 1?
Currently, if input is abcaaabbb output is [('a',1),('b',1),('c',1),('a',3),('b',3)], but I'm looking for abca3b3.
My code:
import Data.List
encode :: [Char] -> [(Char, Int)]
encode s = map go (group s)
where go (x:xs) = (x, length (x:xs))
main = do
s <- getLine
print (encode s)
Last string will be putStrLn (concat (map (\(x,y) -> x : [y]) (encode s))) for convert list to string.
As I am a newbie myself, this is probably not very haskellian. But you can do it about like this (xs as would be the list [('a', 1), ('b', 2), ('a', 3)]):
Create "a1b2a3":
concat $ map (\(c, l) -> c:(show l)) xs
Filter out 1s:
filter (\x -> x /= '1') "a1b2a3"
will give you "ab2a3"
You can't have a list like this in Haskell:
[('a'),('b'),('c'),('a',3),('b',3)]
Each element if a list needs to have the same type in haskell, and ('c') [('a') :: Char] and ('b',3) [('a',1) :: Num t => (Char, t)] are different types.
Maybe also have a look at List of different types?
I would suggest, that you change your list to a (Char, Maybe num) datastructure.
Edit:
From your new question, I think you have been searching for this:
import Data.List
encode :: [Char] -> [(Char, Int)]
encode s = map go (group s)
where go (x:xs) = (x, length (x:xs))
f :: (Char, Int) -> String
f (a, b) = if b == 1 then [a] else [a] ++ show b
encode2 :: [(Char, Int)] -> String
encode2 [] = []
encode2 (x:xs) = f(x) ++ encode2 xs
main = do
s <- getLine
putStrLn $ encode2 $ encode s
Not sure if this suits your needs, but if you do not need filtering, this does the work:
encode::String -> String
encode "" = ""
encode (x:xs) = doIt0 xs x 1 where
doIt0 [] ch currentPos = [ch]++showPos currentPos
doIt0 (x:xs) ch currentPos
|x==ch = doIt0 xs ch $ currentPos+1
|otherwise= [ch]++ (showPos currentPos) ++ (doIt0 xs x 1)
showPos pos = if pos> 1 then show pos else ""
main = do
s <- getLine
print (encode s)