Решение еще некоторых задач на Haskell

Недавно на free-lance.ru в одном из заказов обнаружил вот такое тестовое задание на определение базовых навыков в области программирования:

1) Find the largest palindrome (a palindrome is a number that reads the same in either direction, e.g. 1221) formed by the product of two three-digit numbers.
{Correct answer: 906609}

2) Find the sum of the digits in the number 100! (i.e. 100 factorial)
{Correct answer: 648}

3) Given a list of pairs of numbers e.g. [(1,4), (2,5), (7,3), (4,6), (7,7)] find the longest sub-list that has the pairs sorted by the first entry in ascending order by the second in descending order, [(2,5), (7,3)].

Попробуем решить их на Хаскеле.

Для первой задачи необходимо составить список произведений всех трехзначных чисел (от 100 до 999), после чего отсортировав их в порядке убывания (и удалив дубликаты), найти первое число в списке, которое при представлении строкой будет являть собой палиндром (читаться в обе стороны одинаково).

Я пошел чуть более сложным путем, с целью не использовать стандартные функции сортировки и удаления дубликатов. Идея в следующем. Сначала генерится список, состоящий из 900 списков (числа от 100 до 999), каждый из которых представляет собой список произведений индекса списка (от 100 до 999) на число из диапазона от 999 до индекса списка включительно. Причем списки идут
в обратном порядке. То есть, имеем нечто такого вида:

[ [999*999,999*998,999*997,....,999*100],
  [998*998,998*997,998*996,....,998*100],  
  ...
  [100*100]]

Далее, как нам получить последовательность произведений в убывающем порядке. Очевидно, что максимальный элемент будет расположен в голове одного из подсписков. Мы будем просто проходить по всем спискам, брать их головы (head) и среди них
выбирать максимальный элемент. Чтобы исключить его выбор в дальнейшем, в следующую итерацию будем передавать все списки, обработанные таким образом, что если в их начале был максимальный элемент, то удалять его (таким образом мы избавимся и от возможных дубликатов). Ну а дальше уже, как говорится, дело техники.

Итак, решение первой задачи:

f1 _ [] = 0
f1 f el = f el 

f2 _ [] = []
f2 f el = f el 

delElem x l@(h:t) = if h == x then t else l

task1 = 
    let min1 = 100 in   
    let max1 = 999 in
    let palindr l = sl == reverse sl
                    where sl = show l in
    let lsts =  map (\x -> map (\y -> x * y) [x,x-1..min1]) 
                           [max1,max1-1..min1] in
    let getMax lsts = maximum $ map (f1 head) lsts in
    let delMax lsts m = map (f2 (delElem m)) lsts 
    in
    let main l =  let mx = getMax l in
                  if mx == 0 then error "Not found..." 
                  else if palindr mx then mx
                       else main (delMax l mx) 
    in main lsts            

Решение второй задачи по определению суммы цифр, представляющих факториал 100!, получилось наиболее компактным:

task2 = 
  sum $ map (\x -> read [x]::Int) $ show $ product [1..100]

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

Ну и, наконец, третья задача, наиболее интересная, на мой взгляд.
Нам задан список пар. Требуется найти в ним подсписок максимльной длины, для которого выполняются следующие условия: первые элементы пар отсортированы в возрастающем порядке, а вторые - в убывающем. Примем, что минимальная длина подсписка будет равна 2. Для решения задачи разобъем её на части. Будем формировать подсписки длины от N (длина входного списка) до 2, проверяя после каждой итерации
не появился ли на текущем этапе подсписок, который будет удовлетворять условию, требуемому в задаче (соответствующие сортировки первых и вторых элементов пар), и если такой элемент будет найден, выполнение будет остановлено, а на выход поступит соответствующее значение. Если же на данной итерации элемент не найден, будет выполнен переход на новую итерацию, на которой будут сгенерированы подсписки на единицу меньшей длины, и т.д.

Привожу решение третье задачи:

task3 :: [(Int,Int)] -> [(Int,Int)]
task3 l = 
   let gen l n = 
        let sublst l p n = take n (drop (p-1) l) in
        let lCnt = length l - n + 1 in
        let f l p acc = if p > lCnt then reverse acc 
                        else f l (p+1) (sublst l p n : acc) 
        in if lCnt < 0 then [] else f l 1 []
   in
   let chkOne l = 
        let (l1,l2) = unzip l in 
        let f f' l = zipWith f' l (tail l) in
        (and (f (\x y -> y >= x) l1))
        && (and (f (\x y -> x >= y) l2))
   in    
   let chkLst l = 
        if null l then []
        else let hd = head l in
             if chkOne hd then hd 
             else chkLst (tail l)
   in
   let main n = 
        if n < 2 then error "Correct list not found"
        else 
           let lgen = gen l n in   
           let lChk = chkLst lgen in   
           if not $ null lChk then lChk
           else main (n-1)
   in
   main (length l)

Ну и в завершение вывод результатов решения всех трех задач:

main = do
    print $ "Task 1 result = " ++ show task1
    print $ "Task 2 result = " ++ show task2
    print $ "Task 3 result = " ++ 
            show (task3 [(1,4), (2,5), (7,3), (4,6), (7,7)])

Можете убедиться, что наши результаты совпали с теми ответами, которые приведены после условий задач в самом начале статьи.

На этом всё. Надеюсь, вам было интересно это прочитать )