Если у вас есть подобная матрица и вы хотите сравнить соседние диагональные элементы:
m = [[ 1, 2, 3, 4]
,[ 5, 6, 7, 8]
,[ 9,10,11,12]]
, то вы хотите сделать два сравнения. Во-первых, вы хотите сравнить, элемент за элементом, субматрицу, которую вы получаете, опуская первую строку и первый столбец (слева) с субматрицей, которую вы получаете, опуская последнюю строку и последний столбец (справа):
[[ 6, 7, 8] [[ 1, 2, 3]
,[10,11,12] ,[ 5, 6, 7]]
Во-вторых, вы хотите сравнить, элемент за элементом, субматрицу, которую вы получаете, опуская первую строку и последний столбец (слева) с подматрицей, которую вы получаете, опуская последнюю строку и первый столбец ( справа):
[[ 5, 6, 7] [[ 2, 3, 4]
,[ 9,10,11]] ,[ 6, 7, 8]]
Мы можем построить эти подматрицы, используя init, tail и map s из них:
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
, что дает:
λ> 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]]
Как мы можем сравнить две субматрицы? Ну, мы можем написать двумерную версию zipWith, чтобы применить двоичную функцию (скажем, сравнение) элемент за элементом к двум матрицам, точно так же, как zipWith применяет двоичную функцию элемент за элементом к двум спискам:
zipZipWith :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zipZipWith f m1 m2 = zipWith zipRow m1 m2
where zipRow r1 r2 = zipWith f r1 r2
Это работает, объединяя матрицы, строка за строкой, используя вспомогательную функцию zipRow. Для каждой пары строк zipRow объединяет строки, элемент за элементом, с функцией f. Это определение можно упростить до чуть менее ясного:
zipZipWith f m1 m2 = zipWith (zipWith f) m1 m2
В любом случае, чтобы проверить, являются ли соответствующие пары элементов в двух матрицах отрицательными по отношению друг к другу, мы можем использовать zipZipWith isNeg, где:
isNeg :: (Num a, Eq a) => a -> a -> Bool
isNeg x y = x == -y
Затем, чтобы проверить, являются ли любые из этих пар отрицательными, мы можем использовать concat, чтобы изменить матрицу логических значений в длинный список, и or, чтобы проверить на наличие True значения:
anyNegPairs :: (Num a, Eq a) => [[a]] -> [[a]] -> Bool
anyNegPairs ma mb = or . concat $ zipZipWith isNeg ma mb
Наконец, полная функция для сравнения будет выглядеть следующим образом:
noDiagNeg :: (Num a, Eq a) => [[a]] -> Bool
noDiagNeg m = not (anyNegPairs m1 m2 || anyNegPairs m3 m4)
Поскольку zipZipWith, как и zipWith, игнорирует «дополнительные» элементы, когда сравнивая аргументы разных размеров, на самом деле нет необходимости обрезать последний столбец / строку, поэтому определения подматрицы можно упростить, удалив все init s:
m1 = tail (map tail m)
m2 = m
m3 = tail m
m4 = map tail m
Мы могли бы написать m1 с точки зрения m4 для сохранения двойного вычисления map tail m:
m1 = tail m4
, но компилятор достаточно умен, чтобы понять это самостоятельно.
Итак, разумное окончательное решение будет:
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
и, похоже, в тестовых случаях он работает как нужно:
λ> 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
Это очень похоже на решение @ oisdk, хотя эту версию, возможно, будет легче понять, если вы еще не слишком знакомы со складками.
Сбой на (определенных) матрицах без элементов:
λ> noDiagNeg []
*** Exception: Prelude.tail: empty list
λ> noDiagNeg [[],[]]
*** Exception: Prelude.tail: empty list
, поэтому вы можете использовать метод @ oisdk для замены tail на drop 1, если это проблема. (На самом деле, я мог бы определить tail' = drop 1 как помощника и заменить все tail вызовы на tail' вызовы, так как это выглядело бы немного лучше.)