All geek questions in one place

Build an infinite sorted list without adding duplicates

I am relatively new to Haskell, but I try to learn by reading and trying to solve problems with Project Euler. I'm currently trying to implement a function that accepts an infinite list of integers and returns an ordered list of pairwise sums of elements in the specified list. I am really looking for solutions to the specific problem that I am facing, and not advice on various strategies or approaches, but this is also welcome, since the encoder does not mean knowing how to implement the strategy, but also choosing the best Strategy is available.

My approach is based on traversing an infinite list of infinite generators and extracting elements in order with several mathematical properties that are useful in implementing my solution.

If I tried to get a sequence of pairwise sums of natural numbers, for example, this would be my code:

myList :: [Integer]
myList = [1..]

myGens :: [[Integer]]
myGens = gens myList
    where
        gens = \xs -> map (\x -> [x+y|y<-(dropWhile (<x) xs)]) xs

Regardless of the set of numbers used, provided that it is sorted, the following conditions are true:

  • & FORALL; i & ge; 0head (gens xs !! i) == 2*(myList !! i)
  • & FORALL; i, j, k? 0, l> 0,(((gens xs) !! i) !! j) < (((gens xs) !! i+k) !! j+l)

Special cases for the second condition:

  • & FORALL; i, j? 0(((gens xs) !! i) !! j) < (((gens xs) !! i+1) !! j)
  • & FORALL; i, j? 0, k> 0,(((gens xs) !! i) !! j) < (((gens xs) !! i+k) !! j)

Here is the specific code I'm trying to change:

stride :: [Integer] -> [Int] -> [[Integer]] -> [Integer]
stride xs cs xss = x : stride xs counts streams
        where
            (x,i) = step xs cs xss
            counts = inc i cs
            streams = chop i xss

step :: [Integer] -> [Int] -> [[Integer]] -> (Integer,Int)
step xs cs xss = pace xs (defer cs xss)

pace :: [Integer] -> [(Integer,Int)] -> (Integer,Int)
pace hs xs@((x,i):xt) = minim (x,i) hs xt
    where
        minim :: (Integer,Int) -> [Integer] -> [(Integer,Int)] -> (Integer,Int)
        minim m _ [] = m
        minim m@(g,i) hs (y@(h,n):ynt) | g > h && 2*(hs !! n) > h = y
                                       | g > h = minim y hs ynt
                                       | 2*(hs !! n) > g = m
                                       | otherwise = minim m hs ynt


defer :: [Int] -> [[a]] -> [(a,Int)]
defer cs xss = (infer (zip cs (zip (map head xss) [0..])))

infer :: [(Int,(a,Int))] -> [(a,Int)]
infer [] = []
infer ((c,xi):xis) | c == 0 = xi:[]
                   | otherwise = xi:(infer (dropWhile (\(p,(q,r)) -> p>=c) xis))

The set I have given has the property that several different pairs produce the same amount. I want an efficient method of processing all repeating elements at the same time, in order to avoid increasing the cost of calculating all pairwise sums to N, since this requires M more tests if M is the number of duplicates.

Does anyone have any suggestions?

EDIT:

, , , , .

stride :: [Integer] -> [Int] -> [[Integer]] -> [Integer]
stride xs cs xss = x : stride xs counts streams
where
    (x,is) = step xs cs xss
    counts = foldr (\i -> inc i) cs is
    streams = foldr (\i -> chop i) xss is

step :: [Integer] -> [Int] -> [[Integer]] -> (Integer,[Int])
step xs cs xss = pace xs (defer cs xss)

pace :: [Integer] -> [(Integer,Int)] -> (Integer,[Int])
pace hs xs@((x,i):xt) = minim (x,(i:[])) hs xt
    where
    minim :: (Integer,[Int]) -> [Integer] -> [(Integer,Int)] -> (Integer,[Int])
    minim m _ [] = m
    minim m@(g,is@(i:_)) hs (y@(h,n):ynt) | g > h && 2*(hs !! n) > h = (h,[n])
                              | g > h = minim (h,[n]) hs ynt
                              | g == h && 2*(hs !! n) > h = (g,n:is)
                          | g == h = minim (g,n:is) hs ynt
                          | g < h && 2*(hs !! n) > g = m
                          | g < h = minim m hs ynt

, inc chop:

alter :: (a->a) -> Int -> [a] -> [a]
alter = \f -> \n -> \xs -> (take (n) xs) ++ [f (xs !! n)] ++ (drop (n+1) xs)

inc :: Int -> [Int] -> [Int]
inc = alter (1+)

chop :: Int -> [[a]] -> [[a]]
chop = alter (tail)
+4
4

, . , , ( ).

- .

module Queue where
import Data.Maybe (fromMaybe)

data Queue k = E
             | T k [Queue k]
             deriving Show

fromOrderedList :: (Ord k) => [k] -> Queue k
fromOrderedList [] = E
fromOrderedList [k] = T k []
fromOrderedList (k1 : ks'@(k2 : _ks''))
  | k1 <= k2 = T k1 [fromOrderedList ks']

mergePairs :: (Ord k) => [Queue k] -> Queue k
mergePairs [] = E
mergePairs [q] = q
mergePairs (q1 : q2 : qs'') = merge (merge q1 q2) (mergePairs qs'')

merge :: (Ord k) => Queue k -> Queue k -> Queue k
merge (E) q2 = q2
merge q1 (E) = q1
merge q1@(T k1 q1's) q2@(T k2 q2's)
  = if k1 <= k2 then T k1 (q2 : q1's) else T k2 (q1 : q2's)

deleteMin :: (Ord k) => Queue k -> Maybe (k, Queue k)
deleteMin (E) = Nothing
deleteMin (T k q's) = Just (k, mergePairs q's)

toOrderedList :: (Ord k) => Queue k -> [k]
toOrderedList q
  = fromMaybe [] $
      do (k, q') <- deleteMin q
         return (k : toOrderedList q')

, fromOrderedList . , , , " ". , , .

mergeOrderedByMin , min . , merge, merge .

mergeOrderedByMin :: (Ord k) => [Queue k] -> Queue k
mergeOrderedByMin [] = E
mergeOrderedByMin (E : qs') = mergeOrderedByMin qs'
mergeOrderedByMin (T k q : qs')
  = T k (mergeOrderedByMin qs' : q's)

. , m09, .

nubOrderedList :: (Ord k) => [k] -> [k]
nubOrderedList [] = []
nubOrderedList [k] = [k]
nubOrderedList (k1 : ks'@(k2 : _ks''))
  | k1 < k2 = k1 : nubOrderedList ks'
  | k1 == k2 = nubOrderedList ks'

, . .

squares :: [Integer]
squares = map (^ 2) [0 ..]

sumsOfTwoSquares :: [Integer]
sumsOfTwoSquares
  = nubOrderedList $ toOrderedList $
      mergeOrderedByMin
        [fromOrderedList (map (s +) squares) | s <- squares]
+6

, nub Data.List.Ordered( cabal install data-ordlist) .

, .. , .

+3

[1..] [2..]. " " , .

gens xs

gens xs = map (\t@(x:_) -> map (x+) t) $ tails xs   -- or should it be
     --   map (\(x:ys) -> map (x+) ys) $ tails xs   --                ?

1 ( ),

pairsums xs = foldi (\(x:l) r-> x : union l r) $ gens xs

, . (, , ), orderedNub ( m09 ),

pairsums' = orderedNub . pairsums

foldi, foldr , n log n, . .

1 , :

foldi f (x:xs)  = f x (foldi f (pairs f xs))
pairs f (x:y:t) = f x y : pairs f t
union (x:xs) (y:ys) = case compare x y of           
                          LT -> x : union  xs (y:ys) 
                          EQ -> x : union  xs    ys  
                          GT -> y : union (x:xs) ys

. :

+2

, :

sums xs = zipWith (map . (+)) hs ts where
  (hs:ts) = tails xs

, . , :

filtermerge :: (Ord a) => [[a]]->[a]
filtermerge ((h:t):ts) = h : filtermerge (insert t ts) where
  insert [] ts = ts
  insert xs [] = [xs]   
  insert h ([]:t) = insert h t
  insert (h:t) ts@((h1:t1):t2)
    | h < h1  = (h:t):ts
    | h == h1 = insert (h:t) $ insert t1 t2
    | otherwise = insert (h1:t1) $ insert (h:t) t2
filtermerge _ = []
+1

Source: https://habr.com/ru/post/1538443/

More articles:


All Articles