Scheme Procedure for Permuting Characters in a String

Question

The following is a Scheme procedure to permute the characters in an input string.

• It outputs permutations of all lengths from 1 character up to the number of characters in the input string.
• Duplicates are not part of the output list.

The code is written in Chez Scheme and can be executed from the command line using something like:

chez --program permute.ss abc

producing the output:

(command-line)   : (permute.ss abc)
results          : (a ab abc ac acb b ba bac bc bca c ca cab cb cba)
(length results) : 15

If you plan on checking it, I suggest that you comment out the (display result) line for input strings longer than about four.

Here's the code:

;;
;; permute.ss -- Create a list of all of the permutations of the characters in
;; the input argument. Do not include duplicates. Return permutations with
;; length ranging from 1 to (string-length input-argument).
;;
;; The original algorithm used here was seen at:
;;https://www.geeksforgeeks.org/print-all-the-combinations-of-a-string-in-lexicographical-order/

(import (rnrs))

;; Convert the zero'th to 'last-index'th characters in a vector
;; to a string and return it. No error checking.
(define (vector-front->string vc last-index)
  (let loop ([acc '()]
             [idx last-index])
    (if (>= idx 0)
        (loop (cons (vector-ref vc idx) acc) (- idx 1))
        (list->string acc))))

;; Find all permutations of characters.
(define (permutations-worker result-vec char-vec count-vec level
                             max-res-len num-unique-chars)
  (let ([results '()])
    (letrec ([pw (lambda (rv cv cnt-v lvl mrl nuc)
                   ;; Just return when level is equal to the size of the vector
                   ;; of characters.
                   (when (not (eq? lvl mrl))
                     (let loop ([i 0])
                       (when (< i nuc)
                         (when (not (zero? (vector-ref cnt-v i)))
                           ;;Decrement the occurence count for the character.
                           (vector-set! cnt-v i (- (vector-ref cnt-v i) 1))
                           ;; Store the character in the result.
                           (vector-set! rv lvl (vector-ref cv i))
                           ;; Collect the result for this iteration.
                           (set! results
                                 (cons (vector-front->string rv lvl) results))
                           ;; Call recursively for the next level.
                           (pw rv cv cnt-v (+ 1 lvl) mrl nuc)
                           ;; Backtrack
                           (vector-set! cnt-v i (+ 1 (vector-ref cnt-v i))))
                         (loop (+ 1 i))))))])
      (pw result-vec char-vec count-vec level max-res-len num-unique-chars))
    (reverse results)))

;; Return a list of all permutations of 's'.
(define (permutations s)
  ;; Declare the hash table to store the number of occurences of each character
  ;; in the string.
  (let* ([s-len (string-length s)]
         [mp (make-hashtable char->integer char=? s-len)])

    ;; Record the number of times each character appears in the string.
    (map (lambda (c)
           (hashtable-set! mp c (if (null? (hashtable-ref mp c '()))
                                    1
                                    (+ 1 (hashtable-ref mp c '())))))
         (string->list s))

    ;; Create a vector long enough to hold the largest result.
    (let ([result-vec (make-vector s-len)])
      ;; Initialize a vector with the uniqe characters in the input
      ;; string and a vector of character counts.
      (let-values ([(unique-chars char-counts) (hashtable-entries mp)])
        (permutations-worker result-vec unique-chars char-counts 0
                             s-len (vector-length unique-chars))))))

(define (main)
  (display "(command-line)   : ")
  (display (command-line))
  (newline)

  (let ([results (permutations (cadr (command-line)))])

    (display "results          : ")
    (display results)
    (newline)

    (display "(length results) : ")
    (display (length results))
    (newline)))

(main)

The procedure is used by another program (a simple word unscrambler) where the permutations are checked against the contents of a dictionary.

For inputs of more than 9 or 10 characters, the procedure is too slow since the number of permutations grows so quickly. (The longest word in the dictionary that I use is 28 characters, which is out of the question, of course.)

Is there a more performant approach in idiomatic Scheme that would let me eke out the result for strings with a few more characters?

Update: It is trivial to demonstrate that this procedure does NOT always order the strings in lexicographical order in the output list. Use "trie" as the input, for example.

Update 2: Removed all mention of lexicographic order in output list. Refactored the vector to string conversion procedure so that it builds the returned string in the correct order, removing the need for a call to reverse.