问题
This is a followup to a recent question that wasn't asked clearly. The poster Aditi Jain's clarifications invalidate the answer somewhat that's already posted there, hence this new post.
The objective is to check whether there's no diagonally adjacent pair of elements in the nested lists which are negative of one another. The poster is new to Haskell programming.
The function signature is:
checkNegation :: [[Int]] -> Bool
Examples:
checkNegation [[1,2], [-2,3]] will return False:
[ [ 1 , 2], -- 2, -2 are diagonally adjacent
[-2 , 3] ]
checkNegation [[1,2], [3,-1]] will return False:
[ [ 1 , 2], -- 1, -1 are diagonally adjacent
[ 3 , -1] ]
checkNegation [[1,2], [-1,3]] will return True:
[ [ 1 , 2], -- no diagonally adjacent negatives
[-1 , 3] ]
checkNegation [[0,2,1], [3,1,-2], [3,-1,3]] will return False:
[ [ 0 , 2, 1], -- 2, -2 are diagonally adjacent
[ 3 , 1, -2],
[ 3 , -1, 3] ]
No coding attempts were provided in the original post.
(I'm not marking this as CW so as not to prevent the answerers getting reputation points for their efforts)
回答1:
It's a little easier to do things if we take the matrix row-by-row. For the following, for instance:
[a,b,c],
[d,e,f],
We only want to compare the pairs:
[(a,e),(b,f),(b,d),(c,e)]
So the first step is to write a function which constructs that list from two adjacent rows.
diags xs ys = zip xs (drop 1 ys) ++ zip (drop 1 xs) ys
We're using drop 1 rather than tail because it doesn't error on the empty list, and the way I'm going to use this function later will use empty lists.
If we use this in a fold, then, it looks like the following:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = fst . foldr f (False, [])
where
f xs (a, ys) = (a || or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys), xs)
We've also made it generic over any relation.
Next we will want to figure out how to check if two numbers are negations of each other.
negEachOther x y = negate x == y
And then our check negation function is as follows:
checkNegation = anyDiags negEachOther
There are some fun things we can do with the anyDiags function here. There's actually a use of the writer monad hidden in it. With that, we can rewrite the fold to use that fact:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p = getAny . fst . foldrM f []
where
f xs ys = (Any (or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)), xs)
Though I'm not sure if it's any clearer.
Alternatively, we could do the whole thing using the zip xs (tail xs) trick:
anyDiags :: (a -> a -> Bool) -> [[a]] -> Bool
anyDiags p xs = or (zipWith f xs (tail xs))
where
f xs ys = or (zipWith p xs (drop 1 ys)) || or (zipWith p (drop 1 xs) ys)
回答2:
We can use the diagonals utility from Data.Universe.Helpers package. Such that
λ> diagonals [[0,2,1], [3,1,-2], [3,-1,3]]
[[0],[3,2],[3,1,1],[-1,-2],[3]]
which is only half of what we need. So lets flip our 2D list and apply diagonals once more. Flipping a list would take reverse . transpose operation such that
λ> (reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1,-2,3],[2,1,-1],[0,3,3]]
now we can use diagonals on this flipped list to obtain the remaining diagonals.
λ> (diagonals . reverse . transpose) [[0,2,1], [3,1,-2], [3,-1,3]]
[[1],[2,-2],[0,1,3],[3,-1],[3]]
For all diagonals we need to concatenate them. So altogether we may do like;
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
The rest is applying necessary boolean test.
import Data.List (transpose)
import Data.Universe.Helpers (diagonals)
checkNegation :: Num a => Eq a => [[a]] -> Bool
checkNegation = and . map (and . (zipWith (\x y -> 0 /= (x + y)) <*> tail)) . allDiags
where
allDiags = (++) <$> diagonals . reverse . transpose <*> diagonals
λ> checkNegation [[0,2,1], [3,1,-2], [3,-1,3]]
False
λ> checkNegation [[1,2], [-1,3]]
True
回答3:
First we pair up the rows: first with second, then second with third, then third with fourth, and so on.
Then, for each pair of rows, we consider all wedge-shaped triples of cells, like this:
--*---
-*-*--
So that the bottom-row cells are diagonally adjacent to the top-row ones.
Then we just check if any of the bottom ones are a negative of the top.
Except this has (literally) an edge case: beginnings and ends of the rows. If we do this wedge-shaped triple thing, we're going to miss the first and the last elements of the top row. To get around this, we first wrap the whole matrix in Just and then extend each row with Nothings on left and right:
[a,b,c] ==> [Nothing, Just a, Just b, Just c, Nothing]
[d,e,f] ==> [Nothing, Just d, Just e, Just f, Nothing]
Now we can safely iterate in triples and not miss anything.
checkNegation :: [[Int]] -> Bool
checkNegation matrix = any rowPairHasNegation rowPairs
where
extendedMatrix = map extendRow matrix
extendRow row = [Nothing] ++ map Just row ++ [Nothing]
rowPairs = extendedMatrix `zip` drop 1 extendedMatrix
rowPairHasNegation (row, nextRow) =
any cellTripleHasNegation $
drop 1 row `zip` nextRow `zip` drop 2 nextRow
cellTripleHasNegation ((x1y0, x0y1), x2y1) =
isNegation x1y0 x0y1 || isNegation x1y0 x2y1
isNegation (Just a) (Just b) = a == -b
isNegation _ _ = False
As far as I understand, this will result in iterating over the whole matrix exactly thrice - once as top row and twice as bottom row, meaning O(n*m)
回答4:
If you have a matrix like this and want to compare adjacent diagonal elements:
m = [[ 1, 2, 3, 4]
,[ 5, 6, 7, 8]
,[ 9,10,11,12]]
then you want to make two comparisons. First, you want to compare, element by element, the sub-matrix you get by dropping the first row and first column (left) with the sub-matrix you get by dropping the last row and last column (right):
[[ 6, 7, 8] [[ 1, 2, 3]
,[10,11,12] ,[ 5, 6, 7]]
Second, you want to compare, element by element, the sub-matrix you get by dropping the first row and last column (left) with the sub-matrix you get by dropping the last row and first column (right):
[[ 5, 6, 7] [[ 2, 3, 4]
,[ 9,10,11]] ,[ 6, 7, 8]]
We can construct these submatrices using init, tail, and maps of these:
m1 = tail (map tail m) -- drop first row and first column
m2 = init (map init m) -- drop last row and last column
m3 = tail (map init m) -- drop first row and last column
m4 = init (map tail m) -- drop last row and first column
giving:
λ> m1
[[6,7,8],[10,11,12]]
λ> m2
[[1,2,3],[5,6,7]]
λ> m3
[[5,6,7],[9,10,11]]
λ> m4
[[2,3,4],[6,7,8]]
How do we compare two sub-matrices? Well, we can write a two-dimensional version of zipWith to apply a binary function (a comparison, say) element by element to two matrices, the same way zipWith applies a binary function element by element to two lists:
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith zipRow m1 m2
where zipRow r1 r2 = zipWith f r1 r2
This works by zipping the matrices together, row by row, using the zipRow helper function. For each pair of rows, zipRow zips the rows together, element by element, with the function f. This definition can be simplified to the slightly less clear:
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
Anyway, to check if corresponding pairs of elements in two matrices are negatives of each other, we can use zipZipWith isNeg where:
isNeg :: (Num a, Eq a) => a -> a -> Bool
isNeg x y = x == -y
Then, to check if any of these pairs are negatives, we can use concat to change the matrix of booleans into a long list and or to check for any True values:
anyNegPairs :: (Num a, Eq a) => [[a]] -> [[a]] -> Bool
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
Finally, then, a complete function to perform the comparison would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
Since zipZipWith, like zipWith, ignores "extra" elements when comparing arguments of different sizes, it's not actually necessary to trim off the last column/row, so the sub-matrix definitions can be simplified by removing all the inits:
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
We could actually write m1 in terms of m4 to save double-calculating map tail m:
m1 = tail m4
but the compiler is smart enough to figure this out on its own.
So, a reasonable final solution would be:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
where
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
isNeg x y = x == -y
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
and it seems to work as desired on the test cases:
λ> noDiagNeg [[1,2],[-2,3]]
False
λ> noDiagNeg [[1,2],[3,-1]]
False
λ> noDiagNeg [[1,2],[-1,3]]
True
λ> noDiagNeg [[0,2,1],[3,1,-2],[3,-1,3]]
False
This is quite similar to @oisdk's solution, though this version might be easier to understand if you aren't too familiar with folds yet.
It fails on (certain) matrices with no elements:
λ> noDiagNeg []
*** Exception: Prelude.tail: empty list
λ> noDiagNeg [[],[]]
*** Exception: Prelude.tail: empty list
so you could use @oisdk's technique of replacing tail with drop 1, if this is a problem. (Actually, I might define tail' = drop 1 as a helper and replace all tail calls with tail' calls, since that would look a little nicer.)
来源：https://stackoverflow.com/questions/60798643/testing-diagonally-adjacent-elements-in-nested-lists