Лениво посчитать сумму элементов бесконечных множеств

yroslavasako

Я вот пытаюсь понять как по-красивому в функциональном стиле решить следующую задачу.
Есть бесконечные списки A и B, каждый из которых упорядочен по возрастанию. Требуется лениво вычислить бесконечный список C, элементы которого являются суммой двух произвольных элементов списка A и B, упорядоченный по возрастанию элементов.
Для императивного случая легко придумать решение. А как его писать в функциональном стиле - не представляю. Имеется в виду получить лаконичную запись вроде решета эратосфена.

apl13

Коряво, конечно:
infSum :: (Num a, Ord a) => [a] -> [a] -> [a]

infSum (a:as') (b:_) = infSum as' b (a + b) as bs where

        infSum (h:hs) b lo as bs = let

                hi = h + b

                aPref = takeWhile (< hi) as

                bPref = map (\a -> takeWhile (< hi) $dropWhile (< lo) $map (+ a) bs) aPref

                        in merge bPref ++ infSum hs b hi as bs



merge :: Ord a => [[a]] -> [a]

merge (as:as':ass) = merge (mergeTwo as as':ass) where

        mergeTwo as [] = as

        mergeTwo [] as = as

        mergeTwo (a:as) (b:bs) | a <= b = a:mergeTwo as (b:bs)

                               | otherwise = b:mergeTwo (a:as) bs

merge [as] = as

merge [] = []

Maurog

Для императивного случая легко придумать решение.
я так понял что формулировка нечеткая, то есть таких списков C может быть бесконечное число. тебе не принципиально как именно будет строиться список C ? или предложи императивное решение, его можно будет попробовать переписать на функциональщину

Maurog

тебе не принципиально как именно будет строиться список C ?
я бы начал с такой версии (не уверен, что работает, как задумывалось)
задачу понял неправильно

Maurog

вторая версия без if =)
задачу понял неправильно =\

6yrop

Вроде ж прямолинейно в лоб записывается:
 

static Chain<int> Sum(Chain<int> chain1, Chain<int> chain2)

{

    return  => {

        var unit1 = chain1;

        var unit2 = chain2;

        return Unit.Create(unit1.Value + unit2.Value, Sum(unit1.Next, unit2.Next;

    };

}

В чем проблема?

smit1

(Если я всё правильно понял, то) у тебя каждый элемент одной последовтельности суммируется с тем же по порядку элементом другой, не? А надо, чтоб каждый с каждым.

yroslavasako

фигню пишешь.
Посмотри на диззеденовский вариант, он корректный. Только громоздкий


 take 10 $ infSum [1, 7 ..] [1, 6 ..]

[2,7,8,12,13,14,17,18,19,20]

nikola1956

А что здесь думать? Тем то и хороши функциональные языки программирования, что думать особо не надо, пишем как есть:


module Main where



import System.Environment (getArgs)

import Data.List



-- Оформление ввода из командной строки 

-- нужного пользователю числа элементов в конечном списке



main = do 

  args <- getArgs

  case args of

    [n] -> print (sumList (read n) [13, 26 ..] [2, 4 ..])

    _ -> putStrLn "error: exactly one integer argument needed!"



-- Код искомой функции	



sumList :: Int -> [Int] -> [Int] -> [Int]

sumList n a b = take n (sort $ concat $ square n a b)



square :: Int -> [Int] -> [Int] -> [[Int]]

square n a b = take n [ take n [x + y | x <- a] | y <- b]

P.S. Для тех, кто забыл, напомню, что знак доллара в Haskell — это композиция.

yroslavasako

А что здесь думать? Тем то и хороши функциональные языки программирования, что думать особо не надо, пишем как есть:
там написано, что список бесконечный. Значит ты n на вход получать не будешь, алгоритм должен генерировать бесконечную последовательность

nikola1956

Да, уже понял, спасибо! Не прочитал предыдущего сообщения с уточнением условия задачи:
take 10 $ infSum [1, 7 ..] [1, 6 ..]

[2,7,8,12,13,14,17,18,19,20]

nikola1956



module Main where



import System.Environment (getArgs)

import Data.List



-- Оформление ввода из командной строки 

-- нужного пользователю числа элементов в конечном списке



main = do 

  args <- getArgs

  case args of

    [n] -> print ( take (read n) $ infSum [13, 26 ..] [2, 4 ..])

    _ -> putStrLn "error: exactly one integer argument needed!"



	

-- Код искомой функции	



infSum :: [Int] -> [Int] -> [Int]

infSum a b = [last $ sumList n a b | n <- [1..]]

	

sumList :: Int -> [Int] -> [Int] -> [Int]

sumList n a b = take n (sort $ concat $ square n a b)



square :: Int -> [Int] -> [Int] -> [[Int]]

square n a b = take n [ take n [x + y | x <- a] | y <- b]

Зато очень просто и не надо думать :o

Dasar

идеологически там получается выбор из двух стримов:
  один кэшированный с упорядочиванием и представляет собой набор "уже открытых" подпоследовательностей,
  второй стрим на открытие новой подпоследовательности
сложность - n*log n
если делать без упорядоченного кэша, то сложность будет n^2


  class Program

  {

    static IEnumerable<double> OrderedSum(IEnumerable<double> lefts, IEnumerable<double> rights)

    {      

      var l = lefts.GetEnumerator;

      var r_first = rights.FirstOrDefault;



      var ordered_cache = new[]{ new {n = 0.0, s = 0.0, r = (IEnumerator<double>)null }}.Take(0).ToArray;

      Action<double, IEnumerator<double>> next_item = (s, r) =>

        {

          r.MoveNext;

          ordered_cache = Ordered_Add(ordered_cache, new { n = s + r.Current, s, r }, item => item.n);

        };

      Action next_seq =  =>

        {

          l.MoveNext;

          next_item(l.Current, rights.GetEnumerator;

        };



      next_seq;



      for (; ; )

      {

        var first_cache = ordered_cache.FirstOrDefault;

        if (first_cache.n < l.Current + r_first)

        {

          yield return first_cache.n;

          ordered_cache = Ordered_RemoveFirst(ordered_cache);

          next_item(first_cache.s, first_cache.r);

        }

        else

        {

          yield return l.Current + r_first;

          next_seq;

        }

      }

    }

    static T[] Ordered_RemoveFirst<T>(T[] items)

    {

      return items.Skip(1).ToArray;

    }

    static T[] Ordered_Add<T, TKey>(T[] items, T item, Func<T, TKey> keyer)

    {

      return items.Concat(new[] { item }).OrderBy(keyer).ToArray;

    }

    static void Main(string[] args)

    {

      foreach (var v in OrderedSum(Enumerable.Range(0, 100000).Select(i => i / 2.0 Enumerable.Range(0, 100000).Select(i => i * 2.0 + 1

      {

        Console.WriteLine(v);

      }

    }

  }

ps
под рукой не оказалось готовой сортированной коллекцией, поэтому вместо неё "заготовка".

nikola1956

Более простой код решения твоей задачи, но суть та же:


module Main where



import System.Environment (getArgs)

import Data.List



-- Оформление ввода из командной строки 

-- нужного пользователю числа элементов в конечном списке



main = do 

  args <- getArgs

  case args of

    [n] -> print ( take (read n) $ infSum [1, 7 ..] [1, 6 ..])

    _ -> putStrLn "error: exactly one integer argument needed!"



	

-- Код искомой функции	



infSum :: [Int] -> [Int] -> [Int]

infSum a b = [getElem n a b | n <- [0..]]

	

getElem :: Int -> [Int] -> [Int] -> Int

getElem n a b = (sort $ concat $ square (n + 1) a b) ! n



square :: Int -> [Int] -> [Int] -> [[Int]]

square n a b = take n [ take n [x + y | x <- a] | y <- b]

Напомню, что значок ! — это операция получения элемента списка по индексу.

Maurog

Посмотри на диззеденовский вариант, он корректный.
пытаюсь понять задачу: нужно для списков A, B выдать список C, который задается как sort { a + b | forall a in A, forall b in B}; ? (это метакод, не надо пытаться угадать язык :grin: )

Dasar

sort { a + b | forall a in A, forall b in B}; ?
да

nikola1956

Задача состоит в том, чтобы по двум бесконечным неубывающим спискам A и B построить бесконечный неубывающий список, который состоит из ВСЕХ возможных попарных сумм вида a + b, где a из A, b из B.

Maurog

ВСЕХ возможных попарных сумм вида a + b
спасибо, это самое важное уточнение :grin:

nikola1956

Улучшенный вариант приведенного выше решения "в лоб", работает примерно в 10 раз быстрее. Разница здесь только в том, что для получения очередного элемента списка мы заново не пересчитываем попарные суммы в бесконечной таблице:


module Main where



import System.Environment (getArgs)

import Data.List



-- Оформление ввода из командной строки 

-- нужного пользователю числа элементов в конечном списке



main = do 

  args <- getArgs

  case args of

    [n] -> print ( take (read n) $ infSum [1, 7 ..] [1, 6 ..])

    _ -> putStrLn "error: exactly one integer argument needed!"



	

-- Код искомой функции	



infSum :: [Int] -> [Int] -> [Int]

infSum a b = 

  let table = [ [x + y | x <- a] | y <- b]

  in [getElem n table | n <- [0..]]

	

getElem :: Int -> [[Int]] -> Int

getElem n t = (sort $ concat $ square (n + 1) t) ! n



square :: Int -> [[Int]] -> [[Int]]

square n tab = 

  let t = take n tab

  in [take n row | row <- t]

6yrop

Разница здесь только в том, что для получения очередного элемента списка, мы заново не пересчитываем попарные суммы в бесконечной таблице:
Какая в итоге сложность получилась? n?

rosali

Так ну чо, тряхнем стариной =) мой вариант


module X where

import Data.List



infSum xs ys = process [fstSum (xs,ys)] where

    process zs = s : process (zs' ++ map fstSum (goOn z where

        s,z):zs') = sortBy (\(x,_) (y,_) -> compare x y) zs



    fstSum (x:xs, y:ys) = (x+y, z)



    goOn ([_], [_]) = []

    goOn ([x], y:ys) = [(xs, ys)]

    goOn (x:xs, [y]) = [(xs, ys)]

    goOn (x:xs, y:ys) = [ ([x],ys (xs,[y] (xs,ys) ]

Но так видимо будет медленно, по хорошему надо не пересортировывать каждый раз, а поддерживать пирамиду. Ладно, на первый раз и так сойдет :)

nikola1956

При вычислении k-го элемента (k = 1,..., n) искомого списка проводится сортировка элементов подтаблицы размера k X k. Поэтому в зависимости от алгоритма сортировки сложность алгоритма окажется ориентировочно четвертой степенью n. Точнее, это сумма слагаемых вида k^2 log k для k = 1,..., n.
P.S. Без работающего тега math чувствуешь себя древним греком: они не знали формул и писали все словами :)

rosali

работает примерно в 10 раз быстрее
Ыыы :grin: Твой вариант
 

[xoft hugs]$ time ./y 500 >/dev/null



real    0m5.094s

user    0m5.056s

sys     0m0.028s

Мой


[xoft hugs]$ time ./x 500 > /dev/null



real    0m0.005s

user    0m0.004s

sys     0m0.000s



[xoft hugs]$ time ./x 100000 >/dev/null



real    0m1.384s

user    0m1.376s

sys     0m0.004s

Dasar

ри получении k-го элемента (k = 1,..., n) искомого списка проводится сортировка элементов подтаблицы размера k X k.
нафига такая жесть?
по факту, мы имеем сортировку слиняем упорядоченных ленточек, где на каждом шаге с номером i есть i ленточек. Между i ленточками можно выбрать минимальный элемент за i шагов (если не поддерживать ленточки в отсортированном порядке или за log i (если ленточки упорядочивать по первому элементу еще не вошедшему в выходную последовательность)
соответственно, выборка 1..n элементов будет или n^2, или n*log n

nikola1956

Не совсем понятно, как реализовать это функционально, например, на Haskell-е? Конечно, можно извернуться и вместо использования внутреннего соcтояния (как в императивном алгоритме) усложнить структуры списков, "навесить" на них дополнительные данные и т.п. Но нельзя ли найти "исконно функциональное", красивое и идейно простое решение с лучшими характеристиками, чем тривиальное решение "в лоб", приведенное мной выше?

nikola1956

Поясните, пожалуйста, в чем идея алгоритма? А то через рассматривание Haskell-кода сразу не понятно, является ли это решение искусственным и "императивно вдохновленным" или оно естественное и "исконно функциональное".

alfadred

Еще вариант:
unionS :: (Ord a) => [a] -> [a] -> [a]

unionS [] ys = ys

unionS xs [] = xs

unionS (x:xs) (y:ys) = case compare x y of

  EQ -> x : unionS xs ys

  LT -> x : unionS xs (y:ys)

  GT -> y : unionS (x:xs) ys



-- | Computes the set union of a list @ of sorted lists assuming that @map head  is also sorted

flattenS :: (Ord a) => [[a]] -> [a]

flattenS x:xs):ys:zss) = x : flattenS unionS xs ys):zss)

flattenS [xs] = xs

flattenS [] = []



sumS :: (Ord a, Num a) => [a] -> [a] -> [a]

sumS xs ys = flattenS $ [[x + y | y <- ys] | x <- xs]

yroslavasako

потрясающе выглядит. Лаконично и универсально.

Maurog

Еще вариант:
я так понял в этом варианте дубликаты глотаются
если заюзать http://hackage.haskell.org/package/data-ordlist-0.2/docs/Dat... , то должно получиться еще проще (не проверял =\ ):


import Data.List.Ordered



-- | Computes the set union of a list @ of sorted lists assuming that @map head  is also sorted

flattenS :: (Ord a) => [[a]] -> [a]

flattenS x:xs):ys:zss) = x : flattenS merge xs ys):zss)

flattenS [xs] = xs

flattenS [] = []



sumS :: (Ord a, Num a) => [a] -> [a] -> [a]

sumS xs ys = flattenS $ [[x + y | y <- ys] | x <- xs]

Maurog

должно получиться еще проще
в одну строчку :grin: 


import Data.List.Ordered



sumS :: (Ord a, Num a) => [a] -> [a] -> [a]

sumS xs ys = foldr (\(a:as) b -> a : merge as b) [] [[x + y | y <- ys] | x <- xs]



main = print $ take 20 $ sumS [1, 7..] [1, 6..]

apl13

он корректный.
Единственно, что все элементы правого списка должны быть неотрицательны.

apl13

Вот вариант без такого ограничения, зато только для целых чисел.
Коротко все равно не получается. :(
main = print $take 20 $infSum [1 ..] [2, 4 ..]



infSum :: [Integer] -> [Integer] -> [Integer]

infSum (a:_) (b:_) = [a' + b' | x <- [(a + b) ..]

                                    , a' <- takeWhile (<= (x - b as

                                    , b' <- takeWhile (<= (x - a' bs

                                    , a' + b' == x]

apl13

Хотя, собственно, вот же, положила:
import Data.List



main = do

        print $take 20 $infSum [1 ..] [2, 4 ..]

        print $take 20 $infSum [0.5, 1.0 ..] [1.0, 2.5 ..]



infSum :: (Num a, Ord a, Enum a) => [a] -> [a] -> [a]

infSum (a':_) (b':_) = let slice l = takeWhile (< (l + 1 . dropWhile (< l) in

                                concatMap (\lo -> sort [a + b | a <- takeWhile (< (lo + 1 - b' as

                                                              , b <- slice (lo - a) bs]) [(a' + b') ..]

http://ideone.com/Y3QIen

apl13

Ну или если выделить только ответ на заглавный вопрос треда, то:
import Data.List



infSum :: (Num a, Ord a, Enum a) => [a] -> [a] -> [a]

infSum (a':_) (b':_) = let slice l = takeWhile (< (l + 1 . dropWhile (< l) in

                                concatMap (\lo -> sort [a + b | a <- takeWhile (< (lo + 1 - b' as

                                                              , b <- slice (lo - a) bs]) [(a' + b') ..]

nikola1956

в одну строчку
Да, это лучшее, самое короткое и идейно простое решение из всех предложенных! Если использовать функцию merge (слияние) для упорядоченных списков чисел и правоассоциативную свертку списка (т.е. таблицы который состоит из бесконечных списков чисел, то искомая функция получается в одну строчку:


infSum :: [Int] -> [Int] -> [Int]

infSum a b = foldr (\(x:xs) ys -> x : merge xs ys) [] [ [x + y | x <- a] | y <- b]

И работает молниеносно! :)
Для читателей раздела напомню определения использующихся здесь функций:


foldr :: (a -> b -> b) -> b -> [a] -> b

foldr _ z []     = z

foldr f z (x:xs) = f x (foldr f z xs)



merge :: Ord a => [a] -> [a] -> [a]

merge = mergeBy compare



mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]

mergeBy cmp = loop

  where

    loop [] ys  = ys

    loop xs []  = xs

    loop (x:xs) (y:ys)

      = case cmp x y of

         GT -> y : loop (x:xs) ys

         _  -> x : loop xs (y:ys)

Самым нетривиальным моментом в твоем решении мне показалось использование для свертки списков вместо обычного merge (что не работает) лямба-функции:
(\(x:xs) ys -> x : merge xs ys)

Ты не мог пояснить поподробнее? :)

yroslavasako

Ты не мог пояснить поподробнее?
там вся штука в том, что на каждом шаге должно вычисляться хотя бы одно значение. Тогда мы будем это значение извлекать из бесконечного цикла по-одному. И вот такое вынесение головы списка (гарантированного минимального элемента) и отвечает за конечность расчётов. Вот вам голова, а всё остальное посчитаем потом в хвосте, нагородив merge поверх merge

nikola1956

там вся штука в том, что на каждом шаге должно вычисляться хотя бы одно значение. Тогда мы будем это значение извлекать из бесконечного цикла по-одному. И вот такое вынесение головы списка (гарантированного минимального элемента) и отвечает за конечность расчётов. Вот вам голова, а всё остальное посчитаем потом в хвосте, нагородив merge поверх merge
Да, понятно, это важная, нетривиальная идея, связанная с ленивыми вычислениями. Спасибо, за пояснения и вообще за хороший, познавательный тред! :)
Оставить комментарий
Имя или ник:
Комментарий: