Улучшение производительности кода Racket и ошибок при попытке компиляции байтов

Ответ 1

Вероятно, похоже на решение soegaard, за исключением того, что он переводит свой собственный "парсер", поэтому он сам содержится. Он производит полный 100-летний листинг за 6 секунд на моей машине. Там есть куча трюков, которые использует этот код, но это не совсем то, что можно было бы назвать "оптимизированным" любым серьезным способом: я уверен, что его можно сделать намного быстрее с помощью некоторой мемуаризации, заботы о максимизации совместного использования дерева и т.д. Но для такого небольшого домена это не стоит усилий... (То же самое касается качества этого кода...)

BTW # 1, больше, чем синтаксический анализ, в исходном решении (-ях) используется eval, который не ускоряет работу... Для таких вещей обычно лучше писать "оценщик" вручную. BTW # 2, это не значит, что Racket быстрее Mathematica - я уверен, что решение в этом сообщении заставляет его чередовать лишние циклы процессора, и подобное решение будет быстрее.

#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)))

Ответ 2

Ниже приведена моя реализация. Я настраивал и оптимизировал кое-что в своем коде, на моем ноутбуке требуется около 35 минут (конечно, улучшение!) Я обнаружил, что оценка выражений - это настоящий убийца производительности - если бы не призывы к процедура to-expression, программа завершится через минуту.

Я предполагаю, что в языках программирования, которые изначально используют нотацию infix, оценка будет намного быстрее, но в Scheme затраты на синтаксический анализ и последующее вычисление строки с помощью выражения infix просто слишком много.

Возможно, кто-то может указать подходящую замену для пакета 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))

Используйте его так, чтобы воспроизвести результаты в исходном сообщении в блоге:

(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))))

Ответ 3

Как указывает Оскар, проблема в том, что для этого типа проблемы медленный/инфикс медленный.

Я нашел стандартный синтаксический анализатор для инфиксных выражений на 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")

Инфиксный парсер был написан Эндрю Левенсоном. Синтаксический анализатор и приведенный выше код можно найти здесь:

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

Ответ 4

Это не полный ответ, но я думаю, что это альтернатива библиотеке, о которой просит Оскар Лопес. к сожалению, это в 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 год - см. код выше - но он бы оценил всю последовательность).

поэтому, к сожалению, это не отвечает на вопрос, так как это не быстрее, чем код Оскара Лопеса. я предполагаю, что следующим шагом было бы добавить некоторые оценки в оценку и, таким образом, сэкономить некоторое время. но что?

[ update 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 секунд. все еще не большой, но это очень неэффективный анализ/оценка.

[ update 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))))

Ответ 5

Интересно! Я должен был попробовать это, это в 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