diff --git a/README.md b/README.md index be00774f..992bb9a4 100644 --- a/README.md +++ b/README.md @@ -294,6 +294,8 @@ Other list functions not fit to be classified elsewhere. * [`-last-item`](#-last-item-list) `(list)` * [`-butlast`](#-butlast-list) `(list)` * [`-sort`](#-sort-comparator-list) `(comparator list)` +* [`-to-head`](#-to-head-n-list) `(n list)` +* [`-shuffle`](#-shuffle-list) `(list)` * [`-list`](#-list-arg) `(arg)` * [`-fix`](#-fix-fn-list) `(fn list)` @@ -2317,6 +2319,29 @@ if the first element should sort before the second. (--sort (< it other) '(3 1 2)) ;; => (1 2 3) ``` +#### -to-head `(n list)` + +Return a new list that move the element at `n`th to the head of old `list`. + +```el +(-to-head 3 '(1 2 3 4 5)) ;; => (4 1 2 3 5) +(-to-head 5 '(1 2 3 4 5)) ;; peculiar error +(let ((l '(1 2 3 4 5))) (list (-to-head 2 l) l)) ;; => ((3 1 2 4 5) (1 2 3 4 5)) +``` + +#### -shuffle `(list)` + +Return a new shuffled `list`. + +The returned list is shuffled by using Fisher-Yates' Algorithm. See +https://en.wikipedia.org/wiki/Fisher-Yates_shuffle for more details. + +```el +(progn (random "dash1") (-shuffle '(1 2 3 4 5 6 7))) ;; => (2 7 6 4 5 1 3) +(progn (random "dash2") (-shuffle '(1 2 3 4 5 6 7))) ;; => (1 5 2 4 3 7 6) +(let ((l '(1 2 3 4 5 6 7))) (random "dash3") (list (-shuffle '(1 2 3 4 5 6 7)) l)) ;; => ((3 4 1 5 7 6 2) (1 2 3 4 5 6 7)) +``` + #### -list `(arg)` Ensure `arg` is a list. diff --git a/dash.el b/dash.el index a95ae60b..976fa928 100644 --- a/dash.el +++ b/dash.el @@ -3238,6 +3238,30 @@ if the first element should sort before the second." (declare (debug (def-form form))) `(-sort (lambda (it other) (ignore it other) ,form) ,list)) +(defun -to-head (n list) + "Return a new list that move the element at Nth to the head of old LIST." + (declare (pure t) (side-effect-free t)) + (if (> n (1- (length list))) + (error "Index %d out of the range of list %S" n list)) + (let* ((head (-take n list)) + (rest (-drop n list)) + (target (pop rest))) + (cons target (nconc head rest)))) + +(defun -shuffle (list &optional rng) + "Return a new shuffled LIST, shuffling using RNG. + +The returned list is shuffled by using Fisher-Yates' Algorithm. See +https://en.wikipedia.org/wiki/Fisher-Yates_shuffle for more details." + (declare (pure t) (side-effect-free t)) + (let* ((len (length list)) + (random-nums (-map (or rng #'random) (number-sequence len 1 -1))) + result) + (--each random-nums + (setq list (-to-head it list)) + (push (pop list) result)) + (nreverse result))) + (defun -list (&optional arg &rest args) "Ensure ARG is a list. If ARG is already a list, return it as is (not a copy). diff --git a/dash.texi b/dash.texi index 4497ec8e..f2566806 100644 --- a/dash.texi +++ b/dash.texi @@ -3478,6 +3478,49 @@ if the first element should sort before the second. @end example @end defun +@anchor{-to-head} +@defun -to-head (n list) +Return a new list that move the element at Nth to the head of old @var{list}. + +@example +@group +(-to-head 3 '(1 2 3 4 5)) + @result{} (4 1 2 3 5) +@end group +@group +(-to-head 5 '(1 2 3 4 5)) + @error{} peculiar error +@end group +@group +(let ((l '(1 2 3 4 5))) (list (-to-head 2 l) l)) + @result{} ((3 1 2 4 5) (1 2 3 4 5)) +@end group +@end example +@end defun + +@anchor{-shuffle} +@defun -shuffle (list) +Return a new shuffled @var{list}. + +The returned list is shuffled by using Fisher-Yates' Algorithm. See +https://en.wikipedia.org/wiki/Fisher-Yates_shuffle for more details. + +@example +@group +(progn (random "dash1") (-shuffle '(1 2 3 4 5 6 7))) + @result{} (2 7 6 4 5 1 3) +@end group +@group +(progn (random "dash2") (-shuffle '(1 2 3 4 5 6 7))) + @result{} (1 5 2 4 3 7 6) +@end group +@group +(let ((l '(1 2 3 4 5 6 7))) (random "dash3") (list (-shuffle '(1 2 3 4 5 6 7)) l)) + @result{} ((3 4 1 5 7 6 2) (1 2 3 4 5 6 7)) +@end group +@end example +@end defun + @anchor{-list} @defun -list (arg) Ensure @var{arg} is a list. diff --git a/dev/examples.el b/dev/examples.el index 5c93c10b..5c33a284 100644 --- a/dev/examples.el +++ b/dev/examples.el @@ -53,6 +53,17 @@ (defun even? (num) (= 0 (% num 2))) (defun square (num) (* num num)) +(defun make-xorshift32-rng (seed) + (let ((state (list seed)) + (uint32-max (- (expt 2 32) 1))) + (lambda (limit) + (let* ((seed (car state)) + (step1 (logxor seed (logand uint32-max (ash seed 13)))) + (step2 (logxor step1 (logand uint32-max (ash seed -17)))) + (final (logxor step2 (logand uint32-max (ash step2 5))))) + (setcar state final) + (mod final limit))))) + (def-example-group "Maps" "Functions in this category take a transforming function, which is then applied sequentially to each or selected elements of the @@ -1921,6 +1932,19 @@ related predicates." (--sort (< it other) '(3 1 2)) => '(1 2 3) (let ((l '(3 1 2))) (-sort '> l) l) => '(3 1 2)) + (defexamples -to-head + (-to-head 3 '(1 2 3 4 5)) => '(4 1 2 3 5) + (-to-head 5 '(1 2 3 4 5)) !!> error + (let ((l '(1 2 3 4 5))) + (list (-to-head 2 l) l)) => '((3 1 2 4 5) (1 2 3 4 5))) + + (defexamples -shuffle + (-shuffle '(1 2 3 4 5 6 7) (make-xorshift32-rng #xcafe)) => '(7 6 1 2 3 5 4) + (-shuffle '(1 2 3 4 5 6 7) (make-xorshift32-rng #xbeef)) => '(4 3 2 5 6 7 1) + (let ((l '(1 2 3 4 5 6 7))) + (list (-shuffle '(1 2 3 4 5 6 7) (make-xorshift32-rng #xdead)) l)) => '((3 4 6 5 1 2 7) (1 2 3 4 5 6 7)) + (-shuffle nil) => nil) + (defexamples -list (-list 1) => '(1) (-list '()) => '()