Algorithm 提高Racket代码的性能和尝试字节编译时的错误

我从不同的来源拼凑了几个代码片段，并在上创建了一篇Wolfram博客文章的摘要-对于那些有数学倾向的人来说，这是非常有趣的

毫不奇怪，考虑到我还是Racket的新手，代码计算结果花费的时间太长（作者大于90分钟，而作者为49秒），并且占用了大量内存。我怀疑这一切都与定义（解释）有关，需要重新修改

虽然我在DrRacket中使用它，但是我在编译源代码时也遇到了问题，并且仍然在使用它 （错误消息：

+：预期类型为第一个参数，给定：#f；其他参数为：1-1

）

有人想尝试提高性能和效率吗？我为代码的不可理解性和缺少更好的代码注释而道歉

---

PS：我应该直接在这里剪切和粘贴代码吗？

下面是我的实现。我在你的代码中调整和优化了一两件事，在我的笔记本电脑中完成大约需要35分钟（当然是一个改进！）我发现表达式的计算是真正的性能杀手-如果不是调用过程

到表达式

，程序将在一分钟内完成

我猜想，在本机使用中缀符号的编程语言中，计算速度会快得多，但在Scheme中，解析然后使用中缀表达式计算字符串的成本太高了

也许有人能指出一个合适的替代品？或者，一种直接计算中缀表达式列表并考虑运算符优先级的方法，例如

（1+3-4&7）

——其中

&

表示数字串联，具有最高优先级（例如：

4&7=47

），以及其他算术运算符（

+，-，*，/

）遵循通常的优先规则

#lang at-exp racket

(require (planet soegaard/infix)
         (planet soegaard/infix/parser))

(define (product lst1 lst2) 
  (for*/list ([x (in-list lst1)] 
              [y (in-list lst2)]) 
    (cons x y))) 

(define (tuples lst n)
  (if (zero? n)
      '(())
      (product lst (tuples lst (sub1 n)))))

(define (riffle numbers ops)
  (if (null? ops)
      (list (car numbers))
      (cons (car numbers)
            (cons (car ops)
                  (riffle (cdr numbers)
                          (cdr ops))))))

(define (expression-string numbers optuple)
  (apply string-append
         (riffle numbers optuple)))

(define (to-expression exp-str)
  (eval
   (parse-expression
    #'here (open-input-string exp-str))))

(define (make-all-combinations numbers ops)
  (let loop ((opts (tuples ops (sub1 (length numbers))))
             (acc '()))
    (if (null? opts)
        acc
        (let ((exp-str (expression-string numbers (car opts))))
          (loop (cdr opts)
                (cons (cons exp-str (to-expression exp-str)) acc))))))

(define (show-n-expressions all-combinations years)
  (for-each (lambda (year)
              (for-each (lambda (comb)
                          (when (= (cdr comb) year)
                            (printf "~s ~a~n" year (car comb))))
                        all-combinations)
              (printf "~n"))
            years))

将其像这样用于复制原始文件中的结果：

更新：

我咆哮了Eli Barzilay的表达式计算器，并将其插入到我的解决方案中，现在所有组合的预计算大约在5秒钟内完成！

show-n-expressions

过程仍然需要做一些工作，以避免每次迭代整个组合列表，但这是留给读者的练习。重要的是，现在对所有可能的表达式组合强制执行值的速度非常快

#lang racket

(define (tuples lst n)
  (if (zero? n)
      '(())
      (for*/list ((y (in-list (tuples lst (sub1 n))))
                  (x (in-list lst)))
        (cons x y))))

(define (riffle numbers ops)
  (if (null? ops)
      (list (car numbers))
      (cons (car numbers)
            (cons (car ops)
                  (riffle (cdr numbers)
                          (cdr ops))))))

(define (expression-string numbers optuple)
  (string-append*
   (map (lambda (x)
          (cond ((eq? x '&) "")
                ((symbol? x) (symbol->string x))
                ((number? x) (number->string x))))
        (riffle numbers optuple))))

(define eval-ops
  (let ((precedence (make-hasheq
                     '((& . 3) (/ . 2) (* . 2)
                       (- . 1) (+ . 1) (#f . 0))))
        (apply-op   (lambda (op x y)
                      (case op
                        ((+) (+ x y)) ((-) (- x y))
                        ((*) (* x y)) ((/) (/ x y))
                        ((&) (+ (* 10 x) y))))))
    (lambda (nums ops)
      (let loop ((nums     (cddr nums))
                 (ops      (cdr ops))
                 (numstack (list (cadr nums) (car nums)))
                 (opstack  (list (car ops))))
        (if (and (null? ops) (null? opstack))
            (car numstack)
            (let ((op    (and (pair? ops) (car ops)))
                  (topop (and (pair? opstack) (car opstack))))
              (if (> (hash-ref precedence op)
                     (hash-ref precedence topop))
                  (loop (cdr nums)
                        (cdr ops)
                        (cons (car nums) numstack)
                        (cons op opstack))
                  (loop nums
                        ops
                        (cons (apply-op topop (cadr numstack) (car numstack))
                              (cddr numstack))
                        (cdr opstack)))))))))

(define (make-all-combinations numbers ops)
  (foldl (lambda (optuple tail)
           (cons (cons (eval-ops numbers optuple) optuple) tail))
         empty (tuples ops (sub1 (length numbers)))))

(define (show-n-expressions all-combinations numbers years)
  (for-each (lambda (year)
              (for-each (lambda (comb)
                          (when (= (car comb) year)
                            (printf "~s ~a~n"
                                    year
                                    (expression-string numbers (cdr comb)))))
                        all-combinations)
              (printf "~n"))
            years))

像这样使用它：

(define numbers '(10 9 8 7 6 5 4 3 2 1))
(define ops '(& + - * /))
; this is very fast now!
(define all-combinations (make-all-combinations numbers ops))
(show-n-expressions all-combinations numbers
                    (build-list 5 (lambda (n) (+ n 2012))))

---

这不是一个完整的答案，但我认为这是洛佩斯所要求的图书馆的另一种选择。不幸的是它在clojure，但希望它足够清楚

(def default-priorities
  {'+ 1, '- 1, '* 2, '/ 2, '& 3})

(defn- extend-tree [tree priorities operator value]
  (if (seq? tree)
    (let [[op left right] tree
          [old new] (map priorities [op operator])]
      (if (> new old)
        (list op left (extend-tree right priorities operator value))
        (list operator tree value)))
    (list operator tree value)))

(defn priority-tree
  ([operators values] (priority-tree operators values default-priorities))
  ([operators values priorities] (priority-tree operators values priorities nil))
  ([operators values priorities tree]
    (if-let [operators (seq operators)]
      (if tree
        (recur
          (rest operators) (rest values) priorities
          (extend-tree tree priorities (first operators) (first values)))
        (let [[v1 v2 & values] values]
          (recur (rest operators) values priorities (list (first operators) v1 v2))))
      tree)))

; [] [+ & *] [1 2 3 4] 1+23*4
; [+ 1 2] [& *] [3 4] - initial tree
; [+ 1 [& 2 3]] [*] [4] - binds more strongly than + so replace right-most node
; [+ 1 [* [& 2 3] 4]] [] [] - descend until do not bind more tightly, and extend

(println (priority-tree ['+ '& '*] [1 2 3 4])) ; 1+23*4
(println (priority-tree ['& '- '* '+ '&] [1 2 3 4 5 6])) ; 12 - 3*4 + 56

输出为：

(+ 1 (* (& 2 3) 4))
(+ (- (& 1 2) (* 3 4)) (& 5 6))

[更新]添加以下内容

(defn & [a b] (+ b (* 10 a)))

(defn all-combinations [tokens length]
  (if (> length 0)
    (for [token tokens
          smaller (all-combinations tokens (dec length))]
      (cons token smaller))
    [[]]))

(defn all-expressions [operators digits]
  (map #(priority-tree % digits)
    (all-combinations operators (dec (count digits)))))

(defn all-solutions [target operators digits]
  (doseq [expression
          (filter #(= (eval %) target)
            (all-expressions operators digits))]
    (println expression)))

(all-solutions 2012 ['+ '- '* '/ '&] (range 10 0 -1))

解决了问题，但速度很慢—需要28分钟才能完成。这是一款不错的笔记本电脑（i7-2640M）

（我只打印了2012-见上面的代码-但它会评估整个序列）

因此，不幸的是，这并不能真正回答问题，因为它并不比奥斯卡·洛佩斯的代码快。我想下一步是在评估中加入一些技巧，从而节省一些时间。但是什么呢

[更新2]在阅读了这里的其他帖子后，我将

eval

替换为

(defn my-eval [expr]
  (if (seq? expr)
    (let [[op left right] expr]
      (case op
        + (+ (my-eval left) (my-eval right))
        - (- (my-eval left) (my-eval right))
        * (* (my-eval left) (my-eval right))
        / (/ (my-eval left) (my-eval right))
        & (& (my-eval left) (my-eval right))))
    expr))

运行时间下降到45秒。仍然不是很好，但是这是一个非常低效的解析/评估

[更新3]为完整起见，以下是调车场算法（一个简单的算法，始终保持关联）和相关评估的实现，但它仅将时间减少到35秒

(defn shunting-yard
  ([operators values] (shunting-yard operators values default-priorities))
  ([operators values priorities]
    (let [[value & values] values]
      (shunting-yard operators values priorities nil (list value))))
  ([operators values priorities stack-ops stack-vals]
;    (println operators values stack-ops stack-vals)
    (if-let [[new & short-operators] operators]
      (let [[value & short-values] values]
        (if-let [[old & short-stack-ops] stack-ops]
          (if (> (priorities new) (priorities old))
            (recur short-operators short-values priorities (cons new stack-ops) (cons value stack-vals))
            (recur operators values priorities short-stack-ops (cons old stack-vals)))
          (recur short-operators short-values priorities (list new) (cons value stack-vals))))
      (concat (reverse stack-vals) stack-ops))))

(defn stack-eval
  ([stack] (stack-eval (rest stack) (list (first stack))))
  ([stack values]
    (if-let [[op & stack] stack]
      (let [[right left & tail] values]
        (case op
          + (recur stack (cons (+ left right) tail))
          - (recur stack (cons (- left right) tail))
          * (recur stack (cons (* left right) tail))
          / (recur stack (cons (/ left right) tail))
          & (recur stack (cons (& left right) tail))
          (recur stack (cons op values))))
      (first values))))

---

正如奥斯卡指出的那样，问题在于soegaard/infix对于这类问题的处理速度很慢

我在GitHub上找到了中缀表达式的标准调车场解析器，并在Racket中编写了以下程序：

#lang racket
(require "infix-calc.scm")

(define operators '("*" "/" "+" "-" ""))
(time
(for*/list ([o1  (in-list operators)]
            [o2  (in-list operators)]
            [o3  (in-list operators)]
            [o4  (in-list operators)]
            [o5  (in-list operators)]
            [o6  (in-list operators)]
            [o7  (in-list operators)]
            [o8  (in-list operators)]
            [o9  (in-list operators)]
            [expr (in-value
                  (apply string-append
                        (list "1" o1 "2" o2 "3" o3 "4" o4 "5" o5 "6" o6 "7" o7 "8" o8 "9" o9 "10")))]
             #:when (= (first (calc expr)) 2012))
 expr))

不到3分钟后，结果如下：

Welcome to DrRacket, version 5.2.900.2--2012-03-29(8c22c6c/a) [3m].
Language: racket; memory limit: 128 MB.
cpu time: 144768 real time: 148818 gc time: 25252
'("1*2*3+4*567*8/9-10"
  "1*2+34*56+7+89+10"
  "1*23+45*6*7+89+10"
  "1+2+3/4*5*67*8+9-10"
  "1+2+3+4*567*8/9-10"
  "1+2+34*56+7+8+9*10"
  "1+23+45*6*7+8+9*10"
  "1-2+345*6-7*8+9-10"
  "12*34*5+6+7*8-9*10"
  "12*34*5+6-7-8-9-10"
  "1234+5-6+789-10")

中缀解析器是由Andrew Levenson编写的。 可以在此处找到解析器和上述代码：

---

可能与soegaard的解决方案类似，只是这个解决方案有自己的“解析器”，所以它是自包含的。它在我的机器上用不到6秒的时间就完成了100年的完整清单。这段代码使用了很多技巧，但这并不是真正意义上的“优化”：我确信，通过一些记忆、关注最大化树共享等，它可以变得更快。但是对于这样一个小的领域，它不值得付出努力。。。（此代码的质量也是如此……）

顺便说一句，除了解析，原始解决方案使用

eval

，这并不能加快速度。。。对于这种情况，通常最好手动编写“evaluator”。顺便说一句，这并不意味着Racket比Mathematica快——我相信那篇文章中的解决方案也会让它磨掉冗余的cpu周期，类似的解决方案会更快

#lang racket

(define (tuples list n)
  (let loop ([n n])
    (if (zero? n)
      '(())
      (for*/list ([y (in-list (loop (sub1 n)))] [x (in-list list)])
        (cons x y)))))

(define precedence
  (let ([t (make-hasheq)])
    (for ([ops '((#f) (+ -) (* /) (||))] [n (in-naturals)])
      (for ([op ops]) (hash-set! t op n)))
    t))

(define (do op x y)
  (case op
    [(+) (+ x y)] [(-) (- x y)] [(*) (* x y)] [(/) (/ x y)]
    [(||) (+ (* 10 x) y)]))

(define (run ops nums)
  (unless (= (add1 (length ops)) (length nums)) (error "poof"))
  (let loop ([nums     (cddr nums)]
             [ops      (cdr ops)]
             [numstack (list (cadr nums) (car nums))]
             [opstack  (list (car ops))])
    (if (and (null? ops) (null? opstack))
      (car numstack)
      (let ([op    (and (pair? ops) (car ops))]
            [topop (and (pair? opstack) (car opstack))])
        (if (> (hash-ref precedence op)
               (hash-ref precedence topop))
          (loop (cdr nums)
                (cdr ops)
                (cons (car nums) numstack)
                (cons op opstack))
          (loop nums
                ops
                (cons (do topop (cadr numstack) (car numstack))
                      (cddr numstack))
                (cdr opstack)))))))

(define (expr ops* nums*)
  (define ops  (map symbol->string ops*))
  (define nums (map number->string nums*))
  (string-append* (cons (car nums) (append-map list ops (cdr nums)))))

(define nums  (for/list ([i (in-range 10 0 -1)]) i))
(define year1 2012)
(define nyears 100)
(define year2 (+ year1 nyears))
(define years (make-vector nyears '()))
(for ([ops (in-list (tuples '(+ - * / ||) 9))])
  (define r (run ops nums))
  (when (and (integer? r) (<= year1 r) (< r year2))
    (vector-set! years (- r year1)
                 (cons ops (vector-ref years (- r year1))))))

(for ([solutions (in-vector years)] [year (in-range year1 year2)])
  (if (pair? solutions)
    (printf "~a = ~a~a\n"
            year (expr (car solutions) nums)
            (if (null? (cdr solutions))
              ""
              (format " (~a more)" (length (cdr solutions)))))
    (printf "~a: no combination!\n" year)))

#朗球拍
（定义（元组列表n）
（let循环（[n]）
（如果（零？n）
'(())
（对于*/list（[y（在list中（循环（sub1n）））][x（在list中）]）
(cons x y(()()))
（定义优先级）
（让（[t（make hasheq）]）
（用于（[ops'（#f）（+-）（*/）（| |）][n（自然中）]）
（对于（[op-ops]）（哈希集！topn）））
t） )
（定义（执行op x y）
（案例op）
[（+）（+xy）][（-）（-xy）][（*）（*xy）][（/）（/xy）]
[（| |）（+（*10x）y）]）
（定义（运行操作nums）
（除非（=（添加1（长度操作））（长度nums））（错误“poof”））
（let循环（[nums（cddr nums）]
[ops（cdr ops）]
[numstack（列表（cadr nums）（car nums））]
[操作堆栈（列表（车辆操作））]）
（如果（和（空操作）（空操作堆栈））
（汽车numstack）
（让（[行动（和（对行动）（汽车行动））]
[topop（和（成对操作堆栈）（车载操作堆栈））]
（如果（>（散列参考优先级op）
（哈希参考优先拓扑）
Welcome to DrRacket, version 5.2.900.2--2012-03-29(8c22c6c/a) [3m].
Language: racket; memory limit: 128 MB.
cpu time: 144768 real time: 148818 gc time: 25252
'("1*2*3+4*567*8/9-10"
  "1*2+34*56+7+89+10"
  "1*23+45*6*7+89+10"
  "1+2+3/4*5*67*8+9-10"
  "1+2+3+4*567*8/9-10"
  "1+2+34*56+7+8+9*10"
  "1+23+45*6*7+8+9*10"
  "1-2+345*6-7*8+9-10"
  "12*34*5+6+7*8-9*10"
  "12*34*5+6-7-8-9-10"
  "1234+5-6+789-10")

#lang racket

(define (tuples list n)
  (let loop ([n n])
    (if (zero? n)
      '(())
      (for*/list ([y (in-list (loop (sub1 n)))] [x (in-list list)])
        (cons x y)))))

(define precedence
  (let ([t (make-hasheq)])
    (for ([ops '((#f) (+ -) (* /) (||))] [n (in-naturals)])
      (for ([op ops]) (hash-set! t op n)))
    t))

(define (do op x y)
  (case op
    [(+) (+ x y)] [(-) (- x y)] [(*) (* x y)] [(/) (/ x y)]
    [(||) (+ (* 10 x) y)]))

(define (run ops nums)
  (unless (= (add1 (length ops)) (length nums)) (error "poof"))
  (let loop ([nums     (cddr nums)]
             [ops      (cdr ops)]
             [numstack (list (cadr nums) (car nums))]
             [opstack  (list (car ops))])
    (if (and (null? ops) (null? opstack))
      (car numstack)
      (let ([op    (and (pair? ops) (car ops))]
            [topop (and (pair? opstack) (car opstack))])
        (if (> (hash-ref precedence op)
               (hash-ref precedence topop))
          (loop (cdr nums)
                (cdr ops)
                (cons (car nums) numstack)
                (cons op opstack))
          (loop nums
                ops
                (cons (do topop (cadr numstack) (car numstack))
                      (cddr numstack))
                (cdr opstack)))))))

(define (expr ops* nums*)
  (define ops  (map symbol->string ops*))
  (define nums (map number->string nums*))
  (string-append* (cons (car nums) (append-map list ops (cdr nums)))))

(define nums  (for/list ([i (in-range 10 0 -1)]) i))
(define year1 2012)
(define nyears 100)
(define year2 (+ year1 nyears))
(define years (make-vector nyears '()))
(for ([ops (in-list (tuples '(+ - * / ||) 9))])
  (define r (run ops nums))
  (when (and (integer? r) (<= year1 r) (< r year2))
    (vector-set! years (- r year1)
                 (cons ops (vector-ref years (- r year1))))))

(for ([solutions (in-vector years)] [year (in-range year1 year2)])
  (if (pair? solutions)
    (printf "~a = ~a~a\n"
            year (expr (car solutions) nums)
            (if (null? (cdr solutions))
              ""
              (format " (~a more)" (length (cdr solutions)))))
    (printf "~a: no combination!\n" year)))

from __future__ import division
from math import log
from operator import add, sub, mul 
div = lambda a, b: float(a) / float(b)

years = set(range(2012, 2113))

none = lambda a, b: a * 10 ** (int(log(b, 10)) + 1) + b
priority = {none: 3, mul: 2, div: 2, add: 1, sub: 1}
symbols = {none: '', mul: '*', div: '/', add: '+', sub: '-', None: ''}

def evaluate(numbers, operators):
    ns, ops = [], []
    for n, op in zip(numbers, operators):
        while ops and (op is None or priority[ops[-1]] >= priority[op]):
            last_n = ns.pop()
            last_op = ops.pop()
            n = last_op(last_n, n)
        ns.append(n)
        ops.append(op)
    return n

def display(numbers, operators):
    return ''.join([
        i for n, op in zip(numbers, operators) for i in (str(n), symbols[op])])

def expressions(years):
    numbers = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
    operators = none, add, sub, mul, div
    pools = [operators] * (len(numbers) - 1) + [[None]]
    result = [[]]
    for pool in pools:
        result = [x + [y] for x in result for y in pool]
    for ops in result:
        expression = evaluate(numbers, ops)
        if expression in years:
            yield '%d = %s' % (expression, display(numbers, ops))

for year in sorted(expressions(years)):
    print year