我在HTDP书中做了一个问题,你必须创建一个函数来查找列表的所有排列。这本书给出了main函数,问题要求你创建一个辅助函数,该函数将在列表中的任何地方插入一个元素。称为 insert_everywhere
的帮助函数只给出 2 个参数。
无论我多么努力,我似乎都无法仅使用两个参数创建此函数。
这是我的代码:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
我想要的(insert_everywhere 'a (list 1 2 3))
输出是 (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a)
,但我的列表不断终止。
我已经能够使用第三个参数"位置"创建这个函数,我对该参数进行递归,但这搞砸了我的主要函数。无论如何可以仅使用两个参数创建此帮助程序函数吗?谢谢!
你试过吗:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
insert
函数允许您在列表中的任意位置插入值:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
range
函数允许您创建 Haskell 样式的列表范围:
(range 0 3) => (0 1 2 3)
insert-everywhere
函数利用insert
和range
。很容易理解它是如何工作的。如果你的方案实现没有fold-right
函数(例如 mzscheme(,那么你可以这样定义它:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
顾名思义,fold-right
函数从右侧折叠一个列表。
您可以通过简单地拥有 2 个列表(头部和尾部(并将元素从一个滑动到另一个来做到这一点:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
在 Racket 中,你也可以用相当简洁的方式表达它,如下所示:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
这与我对随处插入过程的回答有很多共同之处。 有一个过程看起来有点奇怪,直到你需要它,然后它非常有用,称为revappend
。 (append '(a b ...) '(x y ...))
返回一个列表(a b ... x y ...)
,其中包含 (a b ...)
的元素。 由于在递归遍历列表时很容易以相反的顺序收集列表,因此有时使用 revappend
很有用,它会反转第一个参数,以便(revappend '(a b ... m n) '(x y ...))
返回(n m ... b a x y ...)
。 revappend
易于高效实施:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
现在,此insert-everywhere
的直接版本很简单。 这个版本不是尾递归的,但它非常简单,并且不做任何不必要的列表复制。 这个想法是,我们沿着lst
走下去,最终得到以下rhead
和tail
:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
如果将递归调用放在...
的位置,则得到所需的结果:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
现在,这不是尾递归。 如果你想要一个尾递归(因此是迭代(版本,你必须以稍微向后的方式构建你的结果,然后在最后反转所有内容。 您可以这样做,但这确实意味着列表的一个额外副本(除非您破坏性地反转它(。
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
如何为帮助程序函数创建一个帮助程序函数?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
我们需要将子列表分开,以便每个子列表都可以单独添加前缀。如果我们过早地附加所有内容,我们将失去边界。所以我们最后只附加一次:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
测试:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
顺便说一下,这个内部函数或多或少是尾递归模缺点,如图所示。这表明应该可以将其转换为迭代形式。约书亚·泰勒展示了另一种方式,使用revappend
。预先反转列表简化了他的解决方案中的流程(现在对应于直接从图中从右到左构建结果行,而不是在我的版本中"按列"(:
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))