Can't find error in code (Project Euler #11 (Haskell)) - haskell
I can't seem to find out why my code isn't working. I think I'm correct and all the examples I've seen do the same thing I do. But when I execute it, I get a different answer. Could someone please help me in finding out what's wrong? (adj4 is my final answer)
type Grid = [[Integer]]
twentyGrid :: [Integer]
twentyGrid = [8,2,22,97,38,15,0,40,0,75,4,5,7,78,52,12,50,77,91,8,49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,4,56,62,0,81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,3,49,13,36,65,52,70,95,23,4,60,11,42,69,24,68,56,1,32,56,71,37,2,36,91,22,31,16,71,51,67,63,89,41,92,36,54,22,40,40,28,66,33,13,80,24,47,32,60,99,3,45,2,44,75,33,53,78,36,84,20,35,17,12,50,32,98,81,28,64,23,67,10,26,38,40,67,59,54,70,66,18,38,64,70,67,26,20,68,2,62,12,20,95,63,94,39,63,8,40,91,66,49,94,21,24,55,58,5,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72,21,36,23,9,75,0,76,44,20,45,35,14,0,61,33,97,34,31,33,95,78,17,53,28,22,75,31,67,15,94,3,80,4,62,16,14,9,53,56,92,16,39,5,42,96,35,31,47,55,58,88,24,0,17,54,24,36,29,85,57,86,56,0,48,35,71,89,7,5,44,44,37,44,60,21,58,51,54,17,58,19,80,81,68,5,94,47,69,28,73,92,13,86,52,17,77,4,89,55,40,4,52,8,83,97,35,99,16,7,97,57,32,16,26,26,79,33,27,98,66,88,36,68,87,57,62,20,72,3,46,33,67,46,55,12,32,63,93,53,69,4,42,16,73,38,25,39,11,24,94,72,18,8,46,29,32,40,62,76,36,20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,4,36,16,20,73,35,29,78,31,90,1,74,31,49,71,48,86,81,16,23,57,5,54,1,70,54,71,83,51,54,69,16,92,33,48,61,43,52,1,89,19,67,48]
rows :: Int -> [Integer] -> Grid --split grid into rows of length n
rows n [] = []
rows n xs = (take n xs):(rows n (drop n xs))
cols :: Int -> [Integer] -> Grid
cols n = (transpose.rows n)
rowGrid :: Grid
rowGrid = rows 20 twentyGrid
colGrid :: Grid
colGrid = cols 20 twentyGrid
getDiag :: Grid-> [Integer] --get a diagonal
getDiag [] = []
getDiag xss
| head xss == [] = []
| otherwise = ((head.head) xss) : (getDiag ((map(drop 1).(drop 1)) xss))
adjac :: Int -> [Integer] -> [[Integer]] -- get all possible combinations of n numbers
adjac 0 xs = []
adjac n [] = []
adjac n (x:xs)
| length (x:xs) > n = (take n (x:xs)) : (adjac n xs)
| otherwise = [x:xs]
diags :: Grid -> Grid
diags [] = []
diags (xs:xss)
| (xs == []) = []
| otherwise =(getDiag (xs:xss)): (diags (map (drop 1) (xs:xss)))
upDiag :: Grid --get upper diaonals
upDiag = diags rowGrid
lowDiag :: Grid -- get lower diagonals
lowDiag = diags colGrid
allCells :: Grid --every diagonal column and row merged together
allCells = rowGrid ++ colGrid ++ upDiag ++ lowDiag
adj4 :: Integer --find largest product of 4 adjacent numbers
adj4 = (maximum.map maximum.map (map product).map (adjac 4)) allCells
testAdj :: [[Integer]]
testAdj = (map (map product).map (adjac 4)) allCells
It looks like you are handling the diagonals that go from upper left to lower right, both above the main diagonal (upDiag) and below the main diagnoal (lowDiag). However, you don't seem to be handling diagonals in the other direction. For example, if you look in the top-left corner of the grid:
08 02 22 97
49 49 99 40 ...
81 49 31 73
52 70 95 23
...
you have no code checking diagonals like the bolded one.
Related
making permutation from two list but not using full number [closed]
Closed. This question needs debugging details. It is not currently accepting answers. Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question. Closed 3 years ago. Improve this question I want to create a list of all possible permutation from two list. However, I do not want to make with full length. For example, first list is ["a", "e", "i", "o" "u"] and second is [1, 2, 3, 4, 5] then one of the outcome would be like [["a",1,"i",2],["u",4,"e",s].....] listsOfPossibilitiesN ::[a] -> [a] -> [[a]] listsOfPossibilitiesN a b = case a of _ -> (listMakerN [] a b (length a) (length b) 0) -- | list = storage, and show at the end of loop, p1h = first list, p2h = second list, -- | count(x) = count to stop loop when the thing is fully rotated, depthCount = count to stop all loop when the depth reached 10 listMakerN :: [a] -> [a] -> [a] -> Integer -> Integer -> Integer -> [[a]] listMakerN list p1h p2h count1 count2 depthCount | depthCount == 10 = [list] | count1 == 0 = [] | otherwise = case p1h of ((x:xs)) -> (listMaker2N (list ++ [x]) xs p2h (count2 - 1) count2 (depthCount + 1)) ++ listMakerN list (xs ++ [x]) p2h (count1 - 1) count2 depthCount listMaker2N :: [a] -> [a] -> [a] -> Integer -> Integer -> Integer -> [[a]] listMaker2N list p1h p2h count1 count2 depthCount | depthCount == 10 = [list] | count2 == 0 = [] | otherwise = case p2h of ((x:xs)) -> (listMakerN (list ++ [x]) p1h xs count1 (count1 ) (depthCount + 1)) ++ listMaker2N list p1h (xs ++ [x]) count1 (count2 - 1) depthCount I made this function above (I am sorry for bad image. I finally could figure out how t put code in question), but it takes too long to get result. How do i do better?(Just to remind you, I am a beginner of programming) and, the output is: > listsOfPossibilitiesN [1,2,3,4,5,6,7,8,9,10] [100,200,300,400,500,600,700,800,900,1000] [[1,100,2,200,3,300,4,400,5,500],[1,100,2,200,3,300,4,400,5,600],[1,100,2,200,3,300,4,400,5,700],[1,100,2,200,3,300,4,400,5,800],[1,100,2,200,3,300,4,400,5,900],[1,100,2,200,3,300,4,400,5,1000],[1,100, 2,200,3,300,4,400,6,500],[1,100,2,200,3,300,4,400,6,600],[1,100,2,200,3,300,4,400,6,700],[1,100,2,200,3,300,4,400,6,800],[1,100,2,200,3,300,4,400,6,900],[1,100,2,200,3,300,4,400,6,1000],[1,100,2,200,3, 300,4,400,7,500],[1,100,2,200,3,300,4,400,7,600],..]
Making a guess at what your current code does, here's a proposal for an algorithm: nondeterministically pick a permutation of the vowels assign indices to the permutation use the standard tails trick to nondeterministically choose the appropriate number of elements from this list In code: import Data.List choose :: Int -> [a] -> [[a]] choose 0 xs = [[]] choose n xs = do x:xs' <- tails xs (x:) <$> choose (n-1) xs' assignments :: Int -> [a] -> [[(Int, a)]] assignments n xs = do xs' <- permutations xs choose n (zip [1..] xs') In ghci: > mapM_ print (assignments 2 "abc") [(1,'a'),(2,'b')] [(1,'a'),(3,'c')] [(2,'b'),(3,'c')] [(1,'b'),(2,'a')] [(1,'b'),(3,'c')] [(2,'a'),(3,'c')] [(1,'c'),(2,'b')] [(1,'c'),(3,'a')] [(2,'b'),(3,'a')] [(1,'b'),(2,'c')] [(1,'b'),(3,'a')] [(2,'c'),(3,'a')] [(1,'c'),(2,'a')] [(1,'c'),(3,'b')] [(2,'a'),(3,'b')] [(1,'a'),(2,'c')] [(1,'a'),(3,'b')] [(2,'c'),(3,'b')]
counting frequencies in a collection of bins
I need to count values inbetween values in a list i.e. [135,136,138,140] would count all the numbers between 135-136,136-138,138-140. with the input list [135.2,135.3,137,139] would out put[2,1,1] using type [Float] [Float] [Int]. So far I have: heightbetween :: Float -> Float -> [Float] -> Int heightbetween _ _ [] = 0 heightbetween n s (x:xs) | (n < x) && (s > x) = 1 + (heightbetween n s xs) | otherwise = heightbetween n s xs count :: [Float] -> [Float] -> [Int] count [] [] = [] count [x,y] = [(x,y)] count (x:y:ys) = (x,y):count (y:ys) forEach fun lst = heightbetween op ([],lst) where op (start,[]) = Nothing op (start,a:as) = Just (start++(fun a):as ,(start++[a],as)) forPairs fun lst lst2 = map (map fst) $ forEach (\(a,b)->(fun a b,b)) $ zip lst lst2
Your count looks strange. It should be like this: -- count -> ranges -> data -> [counts] count :: [Float] -> [Float] -> [Int] count [] _ = [] -- no ranges given -> empty list count [_] _ = [] -- no ranges, but single number -> empty list count _ [] = [] -- no data given -> empty list count (x:y:xs) d = (heightbetween x y d) : count (y:xs) d heightbetween :: Float -> Float -> [Float] -> Int heightbetween _ _ [] = 0 heightbetween n s (x:xs) | (n < x) && (s > x) = 1 + (heightbetween n s xs) | otherwise = heightbetween n s xs The other lines are obsolete. Then invoking count [135,136,138,140] [135.2,135.3,137,139] gives [2,1,1]
First, make sure that your range list is in order.... rangePoints = [135,136,138,140] orderedRangePoints = sort rangePoints Next, you will find it much easier to work with actual ranges (which you can represent using a 2-tuple (low,high)) ranges = zip orderedRangePoints $ tail orderedRangePoints You will need an inRange function (one already exists in Data.Ix, but unfortunately it includes the upperbound, so you can't use it) inRange (low,high) val | val >= low && val < high = True inRange _ _ = False You will also want to order your input points theData = sort [135.2,135.3,137,139] With all of this out of the way, the binCount function is easy to write. binCount'::[(Float, Float)]->[Float]->[Int] binCount' [] [] = [] binCount' (range:rest) vals = length valsInRange:binCount' rest valsAboveRange where (valsInRange, valsAboveRange) = span (`inRange` range) vals Notice, that I defined a function called binCount', not binCount. I did this, because I consider this an unsafe function, because it only works on ordered ranges and values.... You should finalize this by writing a safer binCount function, which puts all of the stuff above in its where clause. You should probably add all the types and some error checking also (what happens if a value is outside of all ranges?).
Euler 75 what is wrong, I have all primitive triangles and multiples but still something fails
Basetri looks just like the wikipedia definition of the euclidian algorithm (but i only save perimeter) , and seems to generate all triangles. Timesify gives all multiples of these triangles (the 120 triangle appears 3 times) Then i concatenate, sort and group to give list of lists with each of the perimeters in same group, then filter the ones with more than 1 just one way to make the perimeter. This should give me all the triangles that are just possible to do in just one way, however length euler75 = 157730 does not seem to be the valid answer. euler75 = filter justOneElement $ group $ sort $ concat $ timesify (takeWhile (<=1500000) basetri) justOneElement (x:[]) = True justOneElement _ = False basetri = [((x m n + y m n + z m n)) | m<-[1..700],n<-[1..(m-1)], odd (m-n),gcd m n == 1] where x m n = (m^2 - n^2) y m n = 2*m*n z m n = (m^2+n^2) timesify [] = [] timesify (x:xs) = (takeWhile (<=1500000) $ (map (*x) [1..])) : timesify xs
Changed to triangs :: Integer -> [Integer] triangs l = [p | n <- [2..1000], m <- [1..n-1], gcd m n == 1, odd (m+n), let p = 2 * (n^2 + m*n), p <= l] and now it works
Printing a matrix with Haskell
I need to print out a matrix in haskell so it looks like this: main> putStr (showMat [[1,-500,-4], [100,15043,6], [5,3,10]]) 1 -500 -4 100 15043 6 5 3 10 So far I have come up with this: type Matrix a = [[a]] type IntMat = Matrix Integer showMat :: IntMat -> String showMat [] = "" showMat ((y:ys):xs) = (printRow (rowmaxs) (elements) (y:ys)) ++ "\n" ++ showMat xs where rowmaxs = rowMaxs ((y:ys):xs) ; elements = elementLengths (y:ys) rowMaxs :: IntMat -> [Int] rowMaxs [] = [] rowMaxs (x:xs) = [length (show (maximum (x)))] ++ (rowMaxs xs) elementLengths :: [Integer] -> [Int] elementLengths [] = [] elementLengths (y:ys) = [length (show y)] ++ (elementLengths ys) printRow :: [Int] -> [Int] -> [Integer] -> String printRow [] (a:as) (y:ys) = "" printRow (z:zs) (a:as) [] = "" printRow [] [] (y:ys) = "" printRow [] [] [] = "" printRow (z:zs) (a:as) (y:ys) = addSpaces (z-a) ++ show y ++ [' '] ++ printRow zs as ys addSpaces :: Int -> String addSpaces 0 = "" addSpaces n = " " ++ addSpaces (n-1) Which returns this: Main> putStr (showMat [[1,23,1],[23,56,789],[1234,0,1]]) 1 23 1 23 56 1234 I can see the loss of the elements at the end of rows is due to the cases in the printRow function, but I don't know how to fix it. Also the characters don't take into account the ones printed before them. Any help on how I can fix this would be appreciated.
I've written a small script some time ago that takes a tab-separated table (CSV style) and prettyprints it to the console. I've extracted the relevant parts and uploaded the source code here. For example, given your input m = [[1,23,456],[78,-90,123],[4567,8,9]] putStrLn $ showMat m will make it into 1 -500 -4 100 15043 6 5 3 10 There's also a function (commented out) at the very bottom if you want left alignment.
In showMat you calculate rowmaxs and elements anew for each row. In particular, rowmaxs has an element for each row left in the matrix, but printRow uses it as meaning something for each column of the matrix. Edit: Here's a slightly better version of showMat: showMat :: IntMat -> String showMat rows = concat (map perRow rows) where rowmaxs = rowMaxs rows perRow cols = printRow rowmaxs elements cols ++ "\n" where elements = elementLengths cols It's still buggy --- rowMaxs (tries to) calculate the maximum length of the numbers in each row, but you really want the maximum length of the numbers in each column. One consequence of that is that you occasionally pass negative numbers to addSpaces, which doesn't cope terribly well, so here's a version of addSpaces that behaves more gracefully: addSpaces :: Int -> String addSpaces n = replicate n ' ' So now we get this: *Main> putStr (showMat [[1,23,1],[23,56,789],[1234,0,1]]) 1 23 1 23 56 789 1234 0 1 Better, but not yet working properly. I have not fixed all the bugs in your code because I sense you are still learning and need the experience of finding them for yourself. I advise using map/zipWith/zipWith3 instead of explicitly writing the recursion, as it makes code easier to understand.
Haskell: problem with recursion
I am trying to format text to be in the shape of a rectangle; currently I have been able to get it properly left justified, but the last line does not extend as far as possible. I am trying to calculate the optimum field width in order to minimise or remove this entirely. I am totally stuck. The code below shows the relevant functions. At the moment it gets stuck in an infinite loop. Where am I going wrong? On a side note, what is the best way of debugging Haskell code? (Yes, I'm very new to this.) optimumFieldWidth is supposed to compare line lengths until the length of the top line is equal to that of the bottom line, then return the field width which causes this to be true. module Main where import System import Data.List main = do (f:_) <- getArgs xs <- getContents putStr (show (bestFieldWidth maxLineLength xs)) bestFieldWidth :: Int -> String -> Int bestFiledWidth _ [] = 0 bestFieldWidth lineLength xs | length (last input) == length (head input) = lineLength | otherwise = bestFieldWidth (length (head (rect (lineLength-1) xs))) xs where input = lines xs rect :: Int -> String -> [String] rect _ [] = [] rect lineLength xs | length input <= len = [input] | otherwise = take len input : rect len (drop len input) where input = trim xs len = bestFieldWidth lineLength xs maxLineLength :: Int maxLineLength = 40 All responses are appreciated. Thank you.
I thought I'd put the actual solution here in case any other nutters wish to do this. Please bear in mind that it was written by a moron so it probably isn't the most elegant solution. maxFieldWidth :: Int maxFieldWidth = 30 rect :: String -> String rect xs = (unlines (chunk (bestFieldWidth (maxFieldWidth) (lines input)) input)) where input = itemsReplace '\n' ' ' xs --Should be called with the point maximum desired width as n bestFieldWidth :: Int -> [String] -> Int bestFieldWidth _ [] = error "bestFieldWidth: Empty List" bestFieldWidth n xs | n == 6 = 6 | 1 == (length (last input)) = n | otherwise = (bestFieldWidth (n-1) xs) where input = chunk n (unlines xs) chunk :: Int -> [a] -> [[a]] chunk n [] = [] chunk n xs = ys : chunk n zs where (ys,zs) = splitAt n xs itemsReplace :: Eq a => a -> a -> [a] -> [a] itemsReplace _ _ [] = [] itemsReplace c r (x:xs) | c == x = r:itemsReplace c r xs | otherwise = x:itemsReplace c r xs
It seems that the condition length (last input) == length (head input) once false never goes true in subsequent calls to area, thus making this function always take the otherwise branch and keep calling itself indefinitely with the same values of xs and thus input. Possible cause of this is that you use the lines function, which splits a string with newline characters, in a way not dependent on lineLength and inconsistent with your line-splitting in the rect function.
In answer to your side note, here is an excellent guide to debugging Haskell: http://cgi.cse.unsw.edu.au/~dons/blog/2007/11/14 There's also Debug.Trace, which allows you to insert print statements. It should of course only be used while debugging, because it makes your function have side effects. http://hackage.haskell.org/packages/archive/base/latest/doc/html/Debug-Trace.html