LINUX.ORG.RU

[Пятница] Сочетания

 


0

1

Вот туплю над простеньким алгоритмом, помню что писал его когда СИКП читал, а сейчас не могу сообразить.

Нужны все не повторяющиеся сочетания из n элментов:

A B C D
1* A+B; A+C; A+D; B+C; B+D; C+D
2* A+B+C; A+B+D; A+C+D; B+C+D
3* A+B+C+D 

Первое, что приходит в голову

A B C
0 0 0 :
0 0 1 : C
0 1 0 : B
0 1 1 : B C
1 0 0 : A
1 0 1 : A C
1 1 0 : A B
1 1 1 : A B C
ugoday ★★★★★
()

Все уже придумано до нас :)

Welcome to Scala version 2.9.1.final (Java HotSpot(TM) Client VM, Java 1.6.0_22).
Type in expressions to have them evaluated.
Type :help for more information.

scala> val xs = List("A", "B", "C", "D")
xs: List[java.lang.String] = List(A, B, C, D)

scala> xs.combinations(3)
res0: Iterator[List[java.lang.String]] = non-empty iterator

scala> xs.combinations(3).toList
res1: List[List[java.lang.String]] = List(List(A, B, C), List(A, B, D), List(A, C, D), List(B, C, D))

scala> val ys = for (i <- 1 to xs.length; x <- xs.combinations(i)) yield x
ys: scala.collection.immutable.IndexedSeq[List[java.lang.String]] = Vector(List(A), List(B), List(C), List(D), List(A, B), List(A, C), List(A, D), List(B, C), List(B, D), List(C, D), List(A, B, C), List(A, B, D), List(A, C, D), List(B, C, D), List(A, B, C, D))
dave ★★★★★
()
Ответ на: комментарий от ugoday

супер... а мне в голову почему-то не пришло :(

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от quickquest

об это мозг сломать можно. Очень слабо выражает алгоритм, по-моему

pseudo-cat ★★★
() автор топика
> filter ((2 ==) . length) $ subsequences "ABCD"
["AB","AC","BC","AD","BD","CD"]
> filter ((3 ==) . length) $ subsequences "ABCD"
["ABC","ABD","ACD","BCD"]
> filter ((4 ==) . length) $ subsequences "ABCD"
["ABCD"]

subsequences - все подсписки данного списка.

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

Вот ещё хаскельная реализация чуть попроще для понимания:

subseqs []     = [[]]
subseqs (x:xs) = f (subseqs xs)
  where f ys = ys ++ map (x:) ys

subseqsOfLen n = filter ((== n) . length) . subseqs

-- *Main> subseqsOfLen 3 [1,2,3,4]
-- [[2,3,4],[1,3,4],[1,2,4],[1,2,3]]

andriyp
()
Ответ на: комментарий от pseudo-cat
(defun subseqs (xs)
  (if (null xs)
      (list (list))
      ((lambda (ys)
         (append ys (mapcar (lambda (zs)
                              (cons (car xs) zs))
                            ys)
                    (list)))
       (subseqs (cdr xs)))))
 
(defun subseqs-of-len (n xs)
  (mapcan (lambda (ys)
            (when (= n (length ys))
              (list ys)))
          (subseqs xs)))
 
(print (subseqs-of-len 3 '(1 2 3 4)))
; => ((2 3 4) (1 3 4) (1 2 4) (1 2 3))
andriyp
()
Ответ на: комментарий от andriyp

код в стиле СИКП, типо «взорви мозг», но понять реально. спасибо

pseudo-cat ★★★
() автор топика

python:

class MyErr: pass

def pairs(lst, deep):
    for i in xrange(len(lst)):
        if deep == 1:
            yield [lst[i]]
        elif deep > 1:   
            for e in pairs(lst[(i+1):], deep-1):
                yield [lst[i]] + e
        else: raise MyErr
>>> list(pairs([1,2,3,4],1))
[[1], [2], [3], [4]]
>>> list(pairs([1,2,3,4],2))
[[1, 2], [1, 3], [1, 4], [2, 3], [2, 4], [3, 4]]
>>> list(pairs([1,2,3,4],3))
[[1, 2, 3], [1, 2, 4], [1, 3, 4], [2, 3, 4]]
>>> list(pairs([1,2,3,4],4))
[[1, 2, 3, 4]]
Norgat ★★★★★
()
Ответ на: комментарий от Norgat

Лишние квадратные скобки - это я просто LORCODE ниасилил толком.

Norgat ★★★★★
()
Ответ на: комментарий от pseudo-cat
;;; (bits-set #b10011) => (0 1 4)
(defun bits-set (number &optional (len (integer-length number)))
  (iter
    (for i from 0 to (1- len))
    (unless (zerop (logand number (ash 1 i)))
      (collect i))))

;;; (indexing '(A B C D E) (bits-set #b10011)) => (A B E)
(defun indexing (list indexes)
  (iter
    (for i in indexes)
    (collect (elt list i))))

(defun subsequences (list)
  (let ((size (length list)))
    (iter
      (for i from 0 to (1- (expt 2 size)))
      (collect (indexing list (bits-set i size))))))

(defun subsequences/length (list len)
  (let ((size (length list)))
    (iter
      (for i from 0 to (1- (expt 2 size)))
      (when (eq len (logcount i))
        (collect (indexing list (bits-set i size)))))))

;;; > (subsequences '(A B C D))
;;; (NIL (A) (B) (A B) (C) (A C) (B C) (A B C) (D) (A D) (B D) (A B D) (C D) (A C D) (B C D) (A B C D))
;;;
;;; > (subsequences/length '(A B C D) 2)
;;; ((A B) (A C) (B C) (A D) (B D) (C D))
quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

Хотя это излишний мудрёж:

(defun subsequences/reduce (list)
  (when list
    (let ((first (first list))
          (rest (rest list)))
      (cons (list first)
            (reduce #'(lambda (e acc)
                        (cons acc (cons (cons first acc) e)))
                    (subsequences/reduce rest)
                    :initial-value nil)))))

(defparameter *list*
  (iter (for i from 0 to 20)
        (collect i)))
(time (progn (subsequences/bits *list*) nil))
Evaluation took:
  8.682 seconds of real time
  8.532534 seconds of total run time (7.592475 user, 0.940059 system)
  [ Run times consist of 4.316 seconds GC time, and 4.217 seconds non-GC time. ]
  98.28% CPU
  18,186,551,891 processor cycles
  369,101,208 bytes consed

(time (progn (subsequences/reduce *list*) nil))
Evaluation took:
  0.725 seconds of real time
  0.716045 seconds of total run time (0.588037 user, 0.128008 system)
  [ Run times consist of 0.636 seconds GC time, and 0.081 seconds non-GC time. ]
  98.76% CPU
  1,518,084,792 processor cycles
  50,333,656 bytes consed
$ cat sub.hs
import Data.List
main = print $ subsequences ([1 .. 20] :: [Int])
$ ghc -O3 sub.hs -o sub
$ time ./sub > /dev/null

real	0m1.043s
user	0m0.992s
sys	0m0.032s
quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

Но может иметь смысл для выборок не всех подцепочек, а только конкретной длинны, получается довольно быстро:

> (time (progn (subsequences/length *list* 2) nil))
Evaluation took:
  0.037 seconds of real time
  0.028001 seconds of total run time (0.028001 user, 0.000000 system)
  75.68% CPU
  77,714,784 processor cycles
  8,192 bytes consed
  
NIL
> (time (progn (subsequences/length *list* 5) nil))
Evaluation took:
  0.092 seconds of real time
  0.088005 seconds of total run time (0.088005 user, 0.000000 system)
  [ Run times consist of 0.040 seconds GC time, and 0.049 seconds non-GC time. ]
  95.65% CPU
  192,008,313 processor cycles
  1,789,952 bytes consed
  
NIL
> (time (progn (subsequences/length *list* 10) nil))
Evaluation took:
  0.952 seconds of real time
  0.940058 seconds of total run time (0.880055 user, 0.060003 system)
  [ Run times consist of 0.264 seconds GC time, and 0.677 seconds non-GC time. ]
  98.74% CPU
  1,993,289,424 processor cycles
  59,256,792 bytes consed
  
NIL
> (time (progn (subsequences/length *list* 15) nil))
Evaluation took:
  0.348 seconds of real time
  0.320020 seconds of total run time (0.276017 user, 0.044003 system)
  [ Run times consist of 0.160 seconds GC time, and 0.161 seconds non-GC time. ]
  91.95% CPU
  727,307,060 processor cycles
  13,458,848 bytes consed
  
NIL
> (time (progn (subsequences/length *list* 19) nil))
Evaluation took:
  0.028 seconds of real time
  0.028002 seconds of total run time (0.028002 user, 0.000000 system)
  100.00% CPU
  57,951,915 processor cycles
  65,536 bytes consed
  
NIL
quasimoto ★★★★
()
Ответ на: комментарий от anonymous

Мы засунули в функцию полный бред: 0 или отрицательное число. Это явно не нормально, поэтому кидаем эксепшн.

Norgat ★★★★★
()
Ответ на: комментарий от pseudo-cat

а что за subsequences/bits

subsequences из этого поста - нерекурсивно ищет все подсписки, но при этом тормозит, т.е. смысла её использовать нет. subsequences/reduce ищет рекурсивно (но не в TCO форме) все подсписки и работает гораздо быстрее. subsequences/length ищет нерекурсивно все подсписки заданной длинны, работает (относительно) очень быстро на малых и больших длинах и достаточно быстро на средних.

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto
#include <stdio.h>
#include <stdlib.h>

void print_subsequences(int *xs, int length)
{
    int i, k;

    for (i = 0; i < 2 << (length - 1); i++) {
        for (k = 0; k < length; k++)
            if (0 != (i & (1 << k)))
                printf("%i ", xs[k]);
        printf("\n");
    }
}

int main(int argc, char **argv)
{
    int i;
    int length = atoi(argv[1]);
    int *xs = malloc(length * sizeof(int));

    for (i = 0; i < length; i++)
        xs[i] = i;

    print_subsequences(xs, length);

    free(xs);

    return 0;
}
$ gcc -O3 sub.c -o sub
$ time ./sub 20 > /dev/null

real	0m1.946s
user	0m1.936s
sys	0m0.008s

Можно ещё попробовать сделать декларации типов в CL, заменить списки массивами и почитать ассемблер.

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

ну ты маньяк :) ты уже завёл блог? я хочу его читать

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от quasimoto

ппц мозг ломает этот reduce. я его похоже так и не осилю.. написал вот более понятную версию. пишу на телефоне - сори за форматирование

 

(defun subseqs (l)
 (when l
   (let* ((f (first l)) (r (rest l))
             (l (subseqs r)))
         (append l
                  (cons (list f)
                       (mapcar (lambda (e) (cons f e))
                           l)))))) 

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от pseudo-cat

ппц мозг ломает этот reduce

reduce вообще или именно тут? http://en.wikipedia.org/wiki/Fold_(higher-order_function) - это про reduce вообще, в данном случае у нас reduce = foldl, вместо z (на картинке) - nil, вместо 1, 2, 3, ... - подсписки (rest list), сворачиваемая f - (lambda (acc e) (cons e (cons (cons first e) acc))), где e - эти самые подсписки, а acc - значение предыдущего применения f.

(let (ncall nreduce)
  (defun subsequences (list)
    (labels
        ((%subsequences (list)
           (setf nreduce 0)        
           (format t "subsequences[~s]: list = ~s~%" ncall list)
           (incf ncall)
           (when list
             (let ((first (first list))
                   (rest (rest list)))
               (cons (list first)
                     (reduce
                      #'(lambda (acc e)
                          (format t "reduce[~s][~s]: acc = ~s, e = ~s~%" ncall nreduce acc e)
                          (incf nreduce)
                          (cons e (cons (cons first e) acc)))
                      (%subsequences rest)
                      :initial-value nil))))))
      (setf ncall 0)
      (%subsequences list))))
CL-USER> (subsequences '())
subsequences[0]: list = NIL
NIL
CL-USER> (subsequences '(1))
subsequences[0]: list = (1)
subsequences[1]: list = NIL
((1))
CL-USER> (subsequences '(1 2))
subsequences[0]: list = (1 2)
subsequences[1]: list = (2)
subsequences[2]: list = NIL
reduce[3][0]: acc = NIL, e = (2)
((1) (2) (1 2))
CL-USER> (subsequences '(1 2 3))
subsequences[0]: list = (1 2 3)
subsequences[1]: list = (2 3)
subsequences[2]: list = (3)
subsequences[3]: list = NIL
reduce[4][0]: acc = NIL, e = (3)
reduce[4][1]: acc = NIL, e = (2)
reduce[4][2]: acc = ((2) (1 2)), e = (3)
reduce[4][3]: acc = ((3) (1 3) (2) (1 2)), e = (2 3)
((1) (2 3) (1 2 3) (3) (1 3) (2) (1 2))
CL-USER> (subsequences '(1 2 3 4))
subsequences[0]: list = (1 2 3 4)
subsequences[1]: list = (2 3 4)
subsequences[2]: list = (3 4)
subsequences[3]: list = (4)
subsequences[4]: list = NIL
reduce[5][0]: acc = NIL, e = (4)
reduce[5][1]: acc = NIL, e = (3)
reduce[5][2]: acc = ((3) (2 3)), e = (4)
reduce[5][3]: acc = ((4) (2 4) (3) (2 3)), e = (3 4)
reduce[5][4]: acc = NIL, e = (2)
reduce[5][5]: acc = ((2) (1 2)), e = (3 4)
reduce[5][6]: acc = ((3 4) (1 3 4) (2) (1 2)), e = (2 3 4)
reduce[5][7]: acc = ((2 3 4) (1 2 3 4) (3 4) (1 3 4) (2) (1 2)), e = (4)
reduce[5][8]: acc = ((4) (1 4) (2 3 4) (1 2 3 4) (3 4) (1 3 4) (2) (1 2)), e = (2 4)
reduce[5][9]: acc = ((2 4) (1 2 4) (4) (1 4) (2 3 4) (1 2 3 4) (3 4) (1 3 4) (2) (1 2)), e = (3)
reduce[5][10]: acc = ((3) (1 3) (2 4) (1 2 4) (4) (1 4) (2 3 4) (1 2 3 4) (3 4) (1 3 4) (2) (1 2)), e = (2 3)
((1) (2 3) (1 2 3) (3) (1 3) (2 4) (1 2 4) (4) (1 4) (2 3 4) (1 2 3 4) (3 4) (1 3 4) (2) (1 2))

т.е. для списка длинной n выполняется n + 1 вызовов subsequences которые строят дерево, дальше это дерево сворачивается с помощью лямбды которую отдали reduce.

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto
- (format t "reduce[~s][~s]: acc = ~s, e = ~s~%" ncall nreduce acc e)
+ (format t "reduce[~s]: acc = ~s, e = ~s~%" nreduce acc e)

суть в том, что все вызовы (lambda (acc e) (cons e (cons (cons first e) acc))) производятся в самом конце, в последнем вызове subsequences.

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

просто сложнее, по-моему, представить себе ф-цию над свёрткой списка, типа ((1 2) (3)) -> car -> ((1 2) (3) (car) (1 2 car) (3 car)) -> cdr ... чем составление нового списка с помощью map.

Хотя в F# я часто использую fold, но в более простых случаях

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от quasimoto

кстати, хоть разница и не велика, но всё же)

CL-USER> (let ((l (loop for i from 0 to 21 collect i)))
	   (progn (time (subseqs l)) nil))
(SUBSEQS L) took 4,437 milliseconds (4.437 seconds) to run 
                    with 1 available CPU core.
During that period, 4,406 milliseconds (4.406 seconds) were spent in user mode
                    16 milliseconds (0.016 seconds) were spent in system mode
4,234 milliseconds (4.234 seconds) was spent in GC.
 100,664,008 bytes of memory allocated.
NIL
CL-USER> (let ((l (loop for i from 0 to 21 collect i)))
	   (progn (time (subsequences/reduce l)) nil))
(SUBSEQUENCES/REDUCE L) took 4,563 milliseconds (4.563 seconds) to run 
                    with 1 available CPU core.
During that period, 4,531 milliseconds (4.531 seconds) were spent in user mode
                    31 milliseconds (0.031 seconds) were spent in system mode
4,375 milliseconds (4.375 seconds) was spent in GC.
 100,664,008 bytes of memory allocated.
NIL
pseudo-cat ★★★
() автор топика
Ответ на: комментарий от pseudo-cat

заработало быстрее без нескольких привязок -

(defun subseqs (l)
  (when l
    (let* ((l (subseqs (rest l))))
      (append l
	      (cons (list (first l))
		    (mapcar (lambda (e) (cons (first l) e))
			    (rest l)))))))
CL-USER> (time (progn (subseqs *l*) nil))
(PROGN (SUBSEQS *L*) NIL) took 1,546 milliseconds (1.546 seconds) to run 
                    with 1 available CPU core.
During that period, 1,500 milliseconds (1.500 seconds) were spent in user mode
                    15 milliseconds (0.015 seconds) were spent in system mode
1,422 milliseconds (1.422 seconds) was spent in GC.
 50,332,552 bytes of memory allocated.
NIL
для F#:
let rec subsequencesMap l =
    match l with 
    | h :: t ->
        let next = subsequencesMap t
        next @ 
            ([h] :: 
                (next |> List.map (fun e -> h :: e)))
    | [] -> []              
> subsequencesMap l;;
Real: 00:00:03.983, CPU: 00:00:03.906, GC gen0: 43, gen1: 24, gen2: 1

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от pseudo-cat

ошибся, вот правильно -

(defun subseqs (l)
  (when l
    (let ((next (subseqs (rest l))))
      (append next
	      (cons (list (first l))
		    (mapcar (lambda (e) (cons (first l) e))
			    next))))))
CL-USER> (time (progn (subseqs *l*) nil))
(PROGN (SUBSEQS *L*) NIL) took 3,766 milliseconds (3.766 seconds) to run 
                    with 1 available CPU core.
During that period, 3,703 milliseconds (3.703 seconds) were spent in user mode
                    16 milliseconds (0.016 seconds) were spent in system mode
3,640 milliseconds (3.640 seconds) was spent in GC.
 100,664,008 bytes of memory allocated.
 SUBSEQS
NIL

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от pseudo-cat
> (let ((l (loop for i from 0 to 21 collect i)))
        (progn (time (subseqs l)) nil))
Evaluation took:
  0.546 seconds of real time
  0.496032 seconds of total run time (0.404026 user, 0.092006 system)
  [ Run times consist of 0.408 seconds GC time, and 0.089 seconds non-GC time. ]
  90.84% CPU
  1,144,029,558 processor cycles
  50,333,192 bytes consed
> (let ((l (loop for i from 0 to 21 collect i)))
        (sb-ext::without-gcing (progn (time (subseqs l)) nil)))
Evaluation took:
  0.077 seconds of real time
  0.080005 seconds of total run time (0.080005 user, 0.000000 system)
  103.90% CPU
  162,940,113 processor cycles
  50,334,960 bytes consed

Куча времени на GC тратиться.

quasimoto ★★★★
()
Ответ на: комментарий от pseudo-cat

Твой алгоритм в хаскеле:

subsequences' [] = []
subsequences' (x:xs) = subs ++ [x] : map (x :) subs
  where subs = subsequences' xs

Тест:


import Data.List
import System.Environment

main :: IO ()
main = do
  mode <- fmap head getArgs
  let xs = [1 .. 22] :: [Int]
  print $ case mode of
    "map" -> subsequences' xs
    "fold" -> subsequences xs

subsequences' :: [a] -> [[a]]
subsequences' [] = []
subsequences' (x:xs) = subs ++ [x] : map (x :) subs
  where subs = subsequences' xs
$ ghc -O3 sub.hs -o sub
$ time ./sub map > /dev/null

real	0m5.369s
user	0m5.168s
sys	0m0.188s
$ time ./sub fold > /dev/null

real	0m4.020s
user	0m3.948s
sys	0m0.052s

Теоретически так и должно быть - в одном случае у нас append (O(n)) от cons (O(1)) от mapcar (O(n)), в другом - cons (O(1)) от reduce (O(n)).

quasimoto ★★★★
()
Ответ на: комментарий от quasimoto

ага, больше чем в 10 раз, я думал GC вызывается только когда память заканчивается

pseudo-cat ★★★
() автор топика
Ответ на: комментарий от pseudo-cat

из-за кучи термов хаскеля в нём сложно разобраться за счёт интуиции

Ну, в хаскеле (+ 1 2) записывает как 1 + 2 :) Так что subs ++ [x] : map (x :) subs это, обратно, (++ subs (: ([] x) (map (lambda (e) (: e x)) subs))), т.е. (append subs (cons (list x) (map (lambda (e) (cons e x)) subs). Тут нужно знать только про определения функций через = с паттерн-матчингом, where, infix, partial applications и sections (только partial applications и sections могут быть не ясны интуитивно, без знания языка, в остальном - почти что обычная математическая нотация).

quasimoto ★★★★
()

Цикл вместо свёртки:

(defun subsequences/iter (list)
  (when list
    (cons
     (list (first list))
     (iter
       (with result)
       (for sub in (subsequences/iter (rest list)))
       (push (cons (first list) sub) result)
       (push sub result)
       (finally (return result))))))
quasimoto ★★★★
()
Ответ на: комментарий от pseudo-cat

а тут важен приоритет cons и append или жёсткий порядок?

У (:) и (++) одинаковый приоритет и правая ассоциативность - x : y ++ z == x : (y ++ z), x ++ y : z == x ++ (y : z). Выражение (x : y) ++ z уже не то же самое что x : y ++ z синтаксически, но то же самое по значению (в силу свойств списков), выражения (x ++ y) : z и x ++ y : z не имеют смысла одновременно (в одном случае x, y :: [a], z :: [[a]], в другом - x, z :: [a], y :: a).

quasimoto ★★★★
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.