[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/ljirZyCY    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Feb 26:
; next greater permutation of digits

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))
      (if (zero? n) d
          (loop (quotient n b)
                (cons (modulo n b) d))))))

(define (undigits ds . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((ds ds) (n 0))
      (if (null? ds) n
          (loop (cdr ds) (+ (* n b) (car ds)))))))

(define (split-front ds)
  (let loop ((fs (cdr ds)) (bs (list (car ds))))
    (cond ((null? fs) (values fs bs))
          ((< (car fs) (car bs)) (values fs bs))
          (else (loop (cdr fs) (cons (car fs) bs))))))

(define (split-back bs s)
  (let loop ((bs bs) (rs (list)))
    (if (< (car bs) s)
        (loop (cdr bs) (cons (car bs) rs))
        (values (append (cdr bs) (list s) rs)
                (car bs)))))

(define (next-perm n)
  (call-with-values
    (lambda () (split-front (reverse (digits n))))
    (lambda (fs bs)
      (if (null? fs) #f ; no solution
        (call-with-values
          (lambda () (split-back (reverse bs) (car fs)))
          (lambda (bs s) (undigits (append
            (reverse (cdr fs)) (list s) (reverse bs)))))))))

(display (next-perm 38276)) (newline)
(display (next-perm 135798642)) (newline)


Output:
1
2
38627
135824679


Create a new paste based on this one


Comments: