2012-04-15 54 views
10

我將來自各種來源的幾個代碼片段合併在一起,並在http://bit.ly/HWdUqK上創建了Wolfram博客文章的crude implementation - 對於那些數學上傾斜的人來說,這非常有趣!毫不奇怪,考慮到我仍然是Racket的新手,代碼需要花費太多時間來計算結果(對於作者來說,> 90分鐘比49秒)並且消耗了大量內存。我懷疑這是關於需要重新定義的定義(expListY)。在嘗試字節編譯時提高球拍代碼和錯誤的性能

雖然我有它在DrRacket的工作,我也有問題字節編譯源,並且仍然在它的工作 (錯誤消息:+: expects type <number> as 1st argument, given: #f; other arguments were: 1 -1)在提高性能

有人要採取防刺效率?我對無法理解的代碼以及缺少更好的代碼評論表示歉意。

PS:我應該直接在這裏剪切和粘貼代碼嗎?

回答

9

大概類似於soegaard的解決方案,除了這一次推出了自己的「語法分析器」,所以它是自包含的。它在我的機器上在6秒內生成完整的100年期清單。這個代碼使用了一堆技巧,但它並不是真正被稱爲「優化」的東西:我確信通過一些備忘錄可以使它更快,關注最大化樹共享等。但是對於這樣一個小的域名來說,這是不值得的努力...(同樣的質量這個代碼...)

順便說一句,超過解析,原來的解決方案(S)使用eval哪讓事情變得更快......對於這樣的事情,通常手動編寫「評估者」會更好。順便說一句,這並不意味着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))) 
+0

超級!只是爲了好奇,我試圖對你的代碼進行字節編譯,希望它比解釋器模式更快,但事實並非如此。 – lifebalance 2012-04-16 08:24:39

+0

這是正確的,請參閱[這個答案](http://stackoverflow.com/questions/10135327/) – 2012-04-16 08:29:33

5

下面是我的實現。我在你的代碼中調整和優化了一兩件事,在我的筆記本電腦中,大約需要35分鐘才能完成(當然是一種改進!)我發現表達式的評估是真正的性能殺手 - 如果它不是用於調用程序​​,該程序將在一分鐘內完成。

我猜想,在本機使用中綴表示法編程語言評價會快得多,但在方案解析成本,然後評估字符串中綴表達式實在太多。

也許有人可以指出一個合適的替代soegaard/infix包?或者直接評估考慮運算符優先級的中綴表達式列表,如 - 其中&代表數字級聯並具有最高優先級(例如: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)))) 

UPDATE:

我snarfed禮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)))) 
+0

將是不錯的有你作爲一個替代的解決方案,所以我會等到你決定如何定義優先級的樹。 – lifebalance 2012-04-16 12:45:43

+0

@lifebalance我會努力工作,但在幾天內。我的工作一週現在開始......我會讓你知道! – 2012-04-16 14:38:10

+0

@lifebalance我無法抗拒誘惑:)我使用Eli的表情評估器更新了我的答案,現在它的速度非常快! – 2012-04-17 03:54:24

3

這不是一個完整的答案,但我認爲這是圖書館奧斯卡·洛佩斯是要求的替代品。不幸的是它在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)) 

解決了這個問題,但它是緩慢的 - 27分鐘才能完成。這是一個不錯的,相當新的筆記本電腦(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秒。仍然不是很好,但它是一個非常低效的解析/評估。爲了完整性,下面是分流碼算法(簡單的總是左聯合)和相關的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)))) 
+0

+1在clojure做。你能發佈你的代碼的米奇鼠標基準嗎?只是對clojure和球拍之間的相對錶現有一個小想法會被癢癢 – lurscher 2012-04-16 02:35:06

+0

28m--見上文。 – 2012-04-16 03:15:58

+0

@andrewcooke我相信,如果我們可以在我的答案中插入你的'priority-tree'過程(請參閱上次編輯),它會比這更快。可悲的是我不能流暢地在clojure中自己做轉換。 – 2012-04-16 03:19:54

4

正如Oscar指出的那樣,問題在於soegaard/infix對於這類問題是緩慢的。

我發現在GitHub上綴表達式標準分流碼解析器和球拍寫了下面的程序:

#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編寫。 解析器和上面的代碼可以在這裏找到:

https://github.com/soegaard/Scheme-Infix-Calculator

+1

在這裏soegaard/infix的主要原因是緩慢的,是在編譯過程中使用scheme/infix的輸出。有幾種開銷來源:首先解析器需要一個端口,所以在解析結果是一個語法對象(通常會被編譯)之後,使用open-input-string將字符串轉換爲端口,但是這裏給出了評估(並使用eval很慢)。 – soegaard 2012-04-16 07:40:35

+0

感謝您的洞察力。不幸的是,我只能在很多好的選擇中選擇一個答案! – lifebalance 2012-04-17 03:15:56

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 
+0

你能再檢查一遍嗎?對於2102,即使按照原始博客文章,也不存在組合。你的答案在win32上生成12個組合(至少在Python IDLE,Python 2.7.2(默認,2011年6月12日,14:24:46)[MSC v.1500 64 bit(AMD64)]:2102 = 10 * 9/8 * 765/4-3 + 2 * 1, 2102 = 10 * 9/8 * 765/4-3 + 2/1,2102 = 10 * 9/8 * 765/4-3/2 * 1,2102 = 10 * 9/8 * 765/4-3/2/1,2102 = 10-9 + 876/5 * 4 * 3 + 2-1,2102 = 10/9 * 876/5 * 4 * 3 + 2 * 1 2102 = 10/9 * 876/5 * 4 * 3 + 2/1 2102 = 10/9 + 876/5 * 4 * 3 + 2-1 2102 = 109 * 8 * 7/6 + 543 * 2-1 2102 = 109 * 87/6 + 543-21 2102 = 10987/6 + 543/2 * 1 2102 = 10987/6 + 543/2/1 – lifebalance 2012-04-21 18:04:01

+0

嘗試「eval()上面的組合,例如'eval('10 -9 + 876/5 * 4 * 3 + 2-1')'說'2012'。不知道爲什麼其他方法顯示不同的結果。可能它與整數除法有關,不知道是否... – 2012-04-24 14:19:03

+0

好吧,我認爲這是因爲整數除法。用運算符import add,sub,mul'和'div = lambda a,b:float(a)/ float(b)',用兩行代替第二行'from operator import add,sub,mul,div'應該像其他方法一樣工作。更多在這裏:http://www.python.org/dev/peps/pep-0238/ – 2012-04-24 14:30:12