我将来自不同来源的几个代码段组合在一起并在crude implementation创建了http://bit.ly/HWdUqK一篇Wolfram博客文章 - 对于那些在数学上倾向的人来说，它非常有趣！
毫不奇怪，鉴于我仍然是Racket的新手，代码需要花费太多时间来计算结果（> 90分钟而不是作者的49秒）并且占用了大量内存。我怀疑这是关于定义（expListY）需要重做的全部内容。
虽然我在DrRacket中工作，但我也遇到了字节编译源代码的问题，并且还在处理它
（错误消息：+: expects type <number> as 1st argument, given: #f; other arguments were: 1 -1）
有人想要提高性能和效率吗？我为无法理解的代码和缺乏更好的代码注释道歉。
PS：我应该直接在这里剪切和粘贴代码吗？
答案 0 :(得分：9)
可能类似于soegaard的解决方案，除了这个解决方案滚动它自己的“解析器”，所以它是自包含的。它在我的机器上产生了不到6秒的完整100年上市。这段代码使用了很多技巧，但它并不是真正以任何严肃的方式被称为“优化”的东西：我确信它可以通过一些记忆，关注最大化树共享等来加快速度。但是对于这么小的域名来说，这不值得付出努力......（同样的代码质量......）
BTW＃1，不仅仅是解析，原始解决方案使用eval这不会让事情变得更快......对于这样的事情，通常最好手动编写“评估者”。 BTW＃2，这并不意味着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)))
答案 1 :(得分：5)
以下是我的实施。我在你的笔记本电脑中调整并优化了一两件事，在我的笔记本电脑中完成需要大约35分钟（当然是一项改进！）我发现表达式的评估是真正的性能杀手 - 如果它不是用于调用程序to-expression，程序将在一分钟内完成。
我想在本地使用中缀表示法的编程语言中，评估速度会快得多，但在Scheme中，解析然后使用中缀表达式评估字符串的成本太高了。
也许有人可以指出soegaard/infix套餐的合适替代品？或者，一种直接评估考虑运算符优先级的中缀表达式列表的方法，比如'(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))
像这样使用它来复制原始blog post：
中的结果(define numbers '("10" "9" "8" "7" "6" "5" "4" "3" "2" "1"))
(define ops '("" "+" "-" "*" "/"))
; beware: this takes around 35 minutes to finish in my laptop
(define all-combinations (make-all-combinations numbers ops))
(show-n-expressions all-combinations
(build-list 5 (lambda (n) (+ n 2012))))
更新：
我咆哮了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))))
答案 2 :(得分：4)
正如Óscar所指出的那样，问题是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编写。 解析器和上面的代码可以在这里找到：
答案 3 :(得分：3)
这不是一个完整的答案，但我认为它是ÓscarLópez要求的图书馆的替代品。不幸的是，这是在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）。
(+ (- (+ 10 (* 9 (& 8 7))) (& 6 5)) (* 4 (& (& 3 2) 1)))
(+ (- (+ (+ (* (* 10 9) 8) 7) 6) 5) (* 4 (& (& 3 2) 1)))
(- (- (+ (- (& 10 9) (* 8 7)) (* (& (& 6 5) 4) 3)) 2) 1)
（我只打印2012年 - 见上面的代码 - 但它会评估整个序列。）
所以，不幸的是，这并没有真正回答这个问题，因为它并不比ÓscarLópez的代码快。我想下一步就是在评估中加入一些智能，这样可以节省一些时间。但是什么？
阅读其他帖子后， [更新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 ]为了完整性，以下是分流码算法（一个总是左关联的简单算法）和相关的eval的实现，但只减少了时间到35S。
(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))))
答案 4 :(得分：3)
有趣！我不得不尝试它，它是在Python中，希望你不介意。它运行大约28秒，PyPy 1.8，Core 2 Duo 1.4
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