smallest larger popcounts

Write a function accepting a natural number n and returning the smallest number larger than n having the same number of one bits.

 $ cat slp.rkt 
 #lang racket 
  
 (require srfi/1) 
  
  
 (define (explode n) 
  
   ; Return a list of bits in the given natural number in little-endian order 
   ; (lsb leftmost) and a trailing zero bit appended. 
  
   (let loop ((n n) (bits '())) 
     (if (zero? n) 
       (reverse (cons 0 bits)) 
       (let-values (((q r) (quotient/remainder n 2))) 
         (loop q (cons r bits)))))) 
  
  
 (define (implode bits) 
  
   ; Return the natural number represented by the give list of bits in 
   ; little-endian order (lsb leftmost). 
    
   (let loop ((bits bits) (po2 1) (n 0)) 
     (if (null? bits) 
        n 
        (loop (cdr bits) (* po2 2) (+ (* (car bits) po2) n))))) 
  
  
 (define (slp n) 
  
   ; Return the smallest value larger than n with the same number of 1s in its 
   ; binary representation. 
  
   ; The idea is to find the rightmost 01 bit pair in n (explode make sure such 
   ; a pair exists) and swap them to get 10.  This produces n' the smallest 
   ; number larger than n that can be produced by swapping a 01 pair.  n' can be 
   ; made smaller but still greater than n by shifting all 1 bits to the right 
   ; of the 01 pair to the right end of the number (shifting 0s in the opposite 
   ; direction). 
  
   (let count-0s ((bits (explode n)) (zero-count 0)) 
     (if (= (car bits) 0) 
       (count-0s (cdr bits) (+ zero-count 1)) 
       (let count-1s ((bits (cdr bits)) (one-count 1)) 
         (if (= (car bits) 1) 
           (count-1s (cdr bits) (+ one-count 1)) 
           (implode 
             (append 
               (make-list (- one-count 1) 1) 
               (make-list zero-count 0) 
               '(0 1) 
               (cdr bits)))))))) 
  
  
 (define (slp-2 n) 
  
   ; Return the smallest value larger than n with the same number of 1s in its 
   ; binary representation. 
  
   ; This code is way stupid (a.k.a. super-exponential) , but it's "obviously 
   ; correct" (generate all permutations of an n-bit number with i 1 bits) and 
   ; useful for testing if the numbers don't get too big. 
  
  
   (define (swap! v i j) 
     (let ((t (vector-ref v i))) 
       (vector-set! v i (vector-ref v j)) 
       (vector-set! v j t))) 
  
    
   (let* 
  
     ((bits (list->vector (explode n))) 
      (bc (vector-length bits)) 
      (best (expt 2 bc))) 
      
     (let outer-loop ((i 0)) 
       (if (= i (- bc 1)) 
  
         (let ((candidate (implode (vector->list bits)))) 
           (when (and (> candidate n) (< candidate best)) 
             (set! best candidate))) 
  
         (let inner-loop ((j (+ i 1))) 
           (unless (= j bc) 
             (swap! bits i j) 
             (outer-loop (+ i 1)) 
             (swap! bits i j) 
             (outer-loop (+ i 1)) 
             (inner-loop (+ j 1)))))) 
  
     best)) 
  
  
 (require rackunit) 
  
 (define (count-1s n) 
   (foldr + 0 (explode n))) 
  
 (do ((i 0 (+ i 1))) ((> i 100) #t) 
   (let ((n (random 1000000000))) 
     (check-eq? n (implode (explode n))))) 
  
 (do ((i 0 (+ i 1))) ((> i 10) #t) 
   (let* ((n (+ (random (expt 2 8)) 1)) 
          (slp-n (slp n))) 
     (check-eq? slp-n (slp-2 n)) 
     (check-eq? (count-1s slp-n) (count-1s n)) 
     (check-true (> slp-n n)))) 
  
 $ racket slp.rkt 
 #t 
 #t 
  
 $