fork download
copy 
  1. ; next identical popcount, revisited
  2.  
  3. (define (digits n . args)
  4.   (let ((b (if (null? args) 10 (car args))))
  5.     (let loop ((n n) (d '()))
  6.       (if (zero? n) d
  7.           (loop (quotient n b)
  8.                 (cons (modulo n b) d))))))
  9.  
  10. (define (undigits ds . args)
  11.   (let ((b (if (null? args) 10 (car args))))
  12.     (let loop ((ds ds) (n 0))
  13.       (if (null? ds) n
  14.           (loop (cdr ds) (+ (* n b) (car ds)))))))
  15.  
  16. (define (next-perm lt? zs)
  17.   (if (null? zs) zs
  18.     (let next ((xlist (list (car zs))) (ys (cdr zs)))
  19.       (cond ((null? ys) (reverse zs))
  20.             ((not (lt? (car ys) (car xlist)))
  21.               (next (cons (car ys) xlist) (cdr ys)))
  22.             (else
  23.               (letrec ((swap
  24.                         (lambda (xs)
  25.                           (cond ((null? (cdr xs))
  26.                                   (cons (car ys) (cons (car xs) (cdr ys))))
  27.                                 ((lt? (car ys) (cadr xs))
  28.                                   (cons (car xs) (swap (cdr xs))))
  29.                                 (else (append (cons (car ys) (cons (cadr xs) (cddr xs)))
  30.                                               (cons (car xs) (cdr ys))))))))
  31.                 (swap xlist)))))))
  32.  
  33. (define (next n)
  34.   (undigits (reverse (next-perm < (reverse (cons 0 (digits n 2))))) 2))
  35.  
  36. (display (next 15)) (newline)
  37. (display (next 23)) (newline)
  38. (display (next (expt 2 30))) (newline)
Success #stdin #stdout 0.04s 8384KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
23
27
2147483648
https://ideone.com/OcRmSv
language:
Scheme (guile 2.2.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!