Лучший способ написать следующую программу в Haskell

Я пишу функцию, которая уменьшает свободные слова. Его можно рассматривать как следующий алгоритм:

Идея состоит в том, чтобы отменить элементы в списке, если они являются отрицательными друг от друга и примыкают друг к другу. Повторно нанесите его, пока его больше не будет отменено. Например [-2,1, -1,2,3] → [-2,2,3] → [3]

Я написал следующий код. Это не кажется элегантным. Он использует голову, хвост много раз, и для этого входа есть 3 шаблона, неплохо, если его можно уменьшить до 2. Я хочу знать, есть ли более элегантные способы написать его в Haskell. Я подозреваю, что могу использовать сгиб для этого, но я не понимаю, как это сделать естественным образом.

freeReduce []  = []
freeReduce [x] = [x]
freeReduce (x:xs)
  | x == -(head xs) = freeReduce (tail xs)
  | otherwise       = if' (rest == [])
                          [x]
                          (if' (x == - (head rest)) (tail rest) (x:rest))
  where rest = freeReduce xs

Ответ 1

Это самое ясное, что я могу сделать:

freeReduce []       = []
freeReduce (x : xs) = case freeReduce xs of
                           y : ys | y == -x ->     ys
                           ys               -> x : ys

Или эквивалентно:

freeReduce = foldr f []
  where f x (y : ys) | y == -x =     ys
        f x ys                 = x : ys

(Оба непроверены.)

Кажется, что freeReduce по своей сути является строгим.

(Моя первоначальная, неправильная попытка:

freeReduce (x : y : rest) | x == -y =     freeReduce rest
freeReduce (x : rest)               = x : freeReduce rest
freeReduce []                       =     []

(тестировалась.))

Ответ 2

Вам нужен доступ к элементам до и после текущей контрольной точки, что-то вроде этого:

freeReduce :: (Num a) => [a] -> [a]
freeReduce = red []
  where red xs         []           = reverse xs
        red (x:xs) (y:ys) | x == -y = red    xs  ys
        red xs     (y:ys)           = red (y:xs) ys

Вы перемещаете элементы из второго списка в первый список и только когда-либо сравниваете верхнюю часть списка. Таким образом, он просматривает список, а затем реверсирует его в конце.

Ответ 3

Не будет ли достаточным следующий код?

freeReduce[] = []
freeReduce(x:xs) 
  | rest == []         = [x]
  | x == -(head rest)  = (tail rest)
  | otherwise          = (x:rest)
  where rest = freeReduce xs

Идея заключается в том, что rest всегда уменьшается как можно больше, и, таким образом, единственный способ стать лучше - иметь x до rest, который отменяет с головой rest, оставляя хвост rest.

Изменить: добавлена строка для обработки пустого rest.

Ответ 4

Вы можете разделить его на две отдельные функции, которые просто проверяют, будут ли первые два элемента списка отменять друг друга, а другой - для сокращения всего списка.

-- check if the first two elements cancel each other
headReduce (x:y:zs) | x == -y = zs
headReduce xs = xs

-- build a whole reduced list from that
freeReduce []     = []
freeReduce (x:xs) = headReduce (x : freeReduce xs)

Это работает, потому что, если список полностью уменьшен, и вы добавляете еще один элемент вперед, единственное новое возможное сокращение состоит в том, что первые два элемента теперь отменяют друг друга. Тогда на индукцию результат freeReduce всегда полностью уменьшается.

Ответ 5

Вот один лайнер, я надеюсь, что он охватывает все случаи, так как я его не тестировал.

freeReduce = foldr (\i a -> if a /= [] && i == -(head a) then tail a else i:a ) []

Ответ 6

Это выглядит как домашнее задание, поэтому я собираюсь дать только намек.

Вам нужно сравнить первые два элемента в списке, но также разрешить списки только с одним элементом или ничем, поэтому ваши случаи выглядят следующим образом:

  freeReduce (x1 : x2 : xs) = ....
  freeReduce [x] = [x]
  freeReduce [] = []

Это охватывает все случаи. Итак, теперь вам просто нужно решить, что делать с соседними элементами x1 и x2, и как передать это в остальную часть вычислений.

Ответ 7

Сбор уже проверенных элементов в обратном списке и переход "на один шаг назад", когда мы найдем соответствие:

freeReduce xs = reduce [] xs where
   reduce acc [] = reverse acc
   reduce [] (x:y:ys) | x == -y = reduce [] ys 
   reduce (a:as) (x:y:ys) | x == -y = reduce as (a:ys) 
   reduce acc (x:xs) = reduce (x:acc) xs