works a little better

main
Matthew Butterick 9 years ago
parent 6c5d629a1a
commit 5a63aae36f

@ -48,38 +48,38 @@
(check-equal?
(for/list : (Listof (List (U Index-Type Value-Type) (U Index-Type Value-Type))) ([j (in-vector col-indices)])
(define h (cast (hash-ref result j) (HashTable Symbol (U Index-Type Value-Type))))
(list (hash-ref h 'value) (hash-ref h 'row-idx)))
(for/list : (Listof (List (U Index-Type Entry-Type) (U Index-Type Entry-Type))) ([j (in-vector col-indices)])
(define h (cast (hash-ref result j) (HashTable Symbol (U Index-Type Entry-Type))))
(list (hash-ref h minima-payload-key) (hash-ref h minima-idx-key)))
'((10.0 3) (20.0 3) (24.0 5) (35.0 5) (35.0 9) (33.0 9) (44.0 9) (43.0 9) (20.0 13))) ; checked against SMAWK.py
(check-equal?
(for/list : (Listof (List Value-Type Index-Type)) ([j (in-vector col-indices)])
(for/list : (Listof (List Entry-Type Index-Type)) ([j (in-vector col-indices)])
(define h (cast (hash-ref result j) (HashTable Symbol Any)))
(list (cast (hash-ref h 'value) Value-Type) (cast (hash-ref h 'row-idx) Index-Type)))
(list (cast (hash-ref h minima-payload-key) Entry-Type) (cast (hash-ref h minima-idx-key) Index-Type)))
'((10.0 3) (20.0 3) (24.0 5) (35.0 5) (35.0 9) (33.0 9) (44.0 9) (43.0 9) (20.0 13))) ; checked against SMAWK.py
(define o (make-ocm simple-proc simple-entry->value))
(check-equal?
(for/list : (Listof (List Value-Type (U Index-Type No-Value-Type))) ([j (in-vector col-indices)])
(list (cast (ocm-min-value o j) Value-Type) (ocm-min-index o j)))
'((0.0 none) (42.0 0) (48.0 1) (51.0 2) (48.0 3) (55.0 4) (59.0 5) (61.0 6) (49.0 7))) ; checked against SMAWK.py
(check-equal?
(for/list : (Listof (List Entry-Type (U Index-Type No-Value-Type))) ([j (in-vector col-indices)])
(list (cast (ocm-min-entry o j) Entry-Type) (ocm-min-index o j)))
'((0.0 none) (42.0 0) (48.0 1) (51.0 2) (48.0 3) (55.0 4) (59.0 5) (61.0 6) (49.0 7))) ; checked against SMAWK.py
(define row-indices2 (cast (list->vector (range (length m2))) (Vectorof Index-Type)))
(define col-indices2 (cast (list->vector (range (length (car m2)))) (Vectorof Index-Type)))
(define result2 (concave-minima row-indices2 col-indices2 simple-proc2 simple-entry->value))
(check-equal?
(for/list : (Listof (List Value-Type Index-Type)) ([j (in-vector col-indices2)])
(define h (cast (hash-ref result2 j) (HashTable Symbol (U Index-Type Value-Type))))
(list (cast (hash-ref h 'value) Value-Type) (cast (hash-ref h 'row-idx) Index-Type)))
'((25.0 0) (21.0 0) (13.0 0) (10.0 0) (20.0 0) (13.0 0) (19.0 0) (35.0 0) (36.0 1) (29.0 8) (29.0 8) (24.0 8) (23.0 8) (20.0 8) (28.0 8) (25.0 8) (31.0 8) (39.0 8))) ; checked against SMAWK.py
(define row-indices2 (cast (list->vector (range (length m2))) (Vectorof Index-Type)))
(define col-indices2 (cast (list->vector (range (length (car m2)))) (Vectorof Index-Type)))
(define result2 (concave-minima row-indices2 col-indices2 simple-proc2 simple-entry->value))
(check-equal?
(for/list : (Listof (List Entry-Type Index-Type)) ([j (in-vector col-indices2)])
(define h (cast (hash-ref result2 j) (HashTable Symbol (U Index-Type Entry-Type))))
(list (cast (hash-ref h minima-payload-key) Entry-Type) (cast (hash-ref h minima-idx-key) Index-Type)))
'((25.0 0) (21.0 0) (13.0 0) (10.0 0) (20.0 0) (13.0 0) (19.0 0) (35.0 0) (36.0 1) (29.0 8) (29.0 8) (24.0 8) (23.0 8) (20.0 8) (28.0 8) (25.0 8) (31.0 8) (39.0 8))) ; checked against SMAWK.py
(define o2 (make-ocm simple-proc2 simple-entry->value))
(check-equal?
(for/list : (Listof (List Value-Type (U Index-Type No-Value-Type))) ([j (in-vector col-indices2)])
(list (cast (ocm-min-value o2 j) Value-Type) (ocm-min-index o2 j)))
'((0.0 none) (21.0 0) (13.0 0) (10.0 0) (20.0 0) (13.0 0) (19.0 0) (35.0 0) (36.0 1) (29.0 8) (-9.0 9) (-10.0 10) (-11.0 11) (-12.0 12) (-13.0 13) (-14.0 14) (-15.0 15) (-16.0 16))) ; checked against SMAWK.py
(check-equal?
(for/list : (Listof (List Entry-Type (U Index-Type No-Value-Type))) ([j (in-vector col-indices2)])
(list (cast (ocm-min-entry o2 j) Entry-Type) (ocm-min-index o2 j)))
'((0.0 none) (21.0 0) (13.0 0) (10.0 0) (20.0 0) (13.0 0) (19.0 0) (35.0 0) (36.0 1) (29.0 8) (-9.0 9) (-10.0 10) (-11.0 11) (-12.0 12) (-13.0 13) (-14.0 14) (-15.0 15) (-16.0 16))) ; checked against SMAWK.py

@ -3,7 +3,7 @@
(require racket/list sugar/debug racket/function racket/vector "logger-typed.rkt")
(define-logger ocm)
(provide smawky? Entry->Value-Type Value-Type No-Value-Type Entry-Type Index-Type Matrix-Proc-Type OCM-Type make-ocm reduce reduce2 concave-minima (prefix-out ocm- (combine-out min-entry min-value min-index)))
(provide minima-idx-key minima-payload-key smawky? Entry->Value-Type Value-Type No-Value-Type Entry-Type Index-Type Matrix-Proc-Type OCM-Type make-ocm reduce reduce2 concave-minima (prefix-out ocm- (combine-out min-entry min-value min-index)))
(: select-elements ((Listof Any) (Listof Index-Type) . -> . (Listof Any)))
(define (select-elements xs is)
@ -121,12 +121,16 @@
;; define a special type so it can be reused in `interpolate`
;; it is (cons value row-idx)
(define minima-idx-key 'row-idx)
(define minima-payload-key 'entry)
(define-type Make-Minimum-Input (Pair Any Index-Type))
(: make-minimum (Make-Minimum-Input . -> . (HashTable Any Any)))
(define (make-minimum value-rowidx-pair)
(define ht ((inst make-hash Any Any)))
(! ht 'value (car value-rowidx-pair))
(! ht 'row-idx (cdr value-rowidx-pair))
(! ht minima-payload-key (car value-rowidx-pair))
(! ht minima-idx-key (cdr value-rowidx-pair))
ht)
@ -143,7 +147,7 @@
(define idx-of-last-row
(cast (if (= col-idx (sub1 (vector-length col-indices)))
(vector-last row-indices)
(hash-ref (cast (hash-ref minima (vector-ref col-indices (add1 col-idx))) HashTableTop) 'row-idx)) Index-Type))
(hash-ref (cast (hash-ref minima (vector-ref col-indices (add1 col-idx))) HashTableTop) minima-idx-key)) Index-Type))
(define smallest-value-entry
((inst vector-argmin Make-Minimum-Input) (λ(x) (entry->value (car x)))
@ -165,7 +169,7 @@
(for ([([col : Index-Type] col-idx) (in-indexed col-indices)] #:when (even? col-idx))
(define idx-of-last-row (cast (if (= col-idx idx-of-last-col)
(vector-last row-indices)
(hash-ref (cast (hash-ref minima (vector-ref col-indices (add1 col-idx))) HashTableTop) 'row-idx)) Index-Type))
(hash-ref (cast (hash-ref minima (vector-ref col-indices (add1 col-idx))) HashTableTop) minima-idx-key)) Index-Type))
(! minima col (make-minimum (smallest-value-entry col idx-of-last-row))))
minima)
@ -248,11 +252,11 @@
(for ([col (in-vector cols)])
(cond
[(>= col (vector-length ($ocm-min-entrys ocm)))
(set-$ocm-min-entrys! ocm (vector-append-entry ($ocm-min-entrys ocm) (@ (cast (@ minima col) (HashTable Symbol Entry-Type)) 'value)))
(set-$ocm-min-row-indices! ocm (vector-append-index ($ocm-min-row-indices ocm) (@ (cast (@ minima col) (HashTable Symbol Index-Type)) 'row-idx)))]
[(< (($ocm-entry->value ocm) (@ (cast (@ minima col) HashTableTop) 'value)) (($ocm-entry->value ocm) (vector-ref ($ocm-min-entrys ocm) col)))
(set-$ocm-min-entrys! ocm ((inst vector-set Entry-Type) ($ocm-min-entrys ocm) col (cast (@ (cast (@ minima col) HashTableTop) 'value) Value-Type)))
(set-$ocm-min-row-indices! ocm ((inst vector-set (U Index-Type No-Value-Type)) ($ocm-min-row-indices ocm) col (cast (@ (cast (@ minima col) HashTableTop) 'row-idx) Index-Type)))]))
(set-$ocm-min-entrys! ocm (vector-append-entry ($ocm-min-entrys ocm) (@ (cast (@ minima col) (HashTable Symbol Entry-Type)) minima-payload-key)))
(set-$ocm-min-row-indices! ocm (vector-append-index ($ocm-min-row-indices ocm) (@ (cast (@ minima col) (HashTable Symbol Index-Type)) minima-idx-key)))]
[(< (($ocm-entry->value ocm) (@ (cast (@ minima col) HashTableTop) minima-payload-key)) (($ocm-entry->value ocm) (vector-ref ($ocm-min-entrys ocm) col)))
(set-$ocm-min-entrys! ocm ((inst vector-set Entry-Type) ($ocm-min-entrys ocm) col (cast (@ (cast (@ minima col) HashTableTop) minima-payload-key) Entry-Type)))
(set-$ocm-min-row-indices! ocm ((inst vector-set (U Index-Type No-Value-Type)) ($ocm-min-row-indices ocm) col (cast (@ (cast (@ minima col) HashTableTop) minima-idx-key) Index-Type)))]))
(set-$ocm-finished! ocm next)]

@ -585,10 +585,14 @@
;(define eqs (split-quad (block '(x-align center font "Equity Text B" size 10) "Foo-d" (word '(size 13) "og ") "and " (box) " Zu" (word-break '(nb "c" bb "k-")) "kerman's. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a new syntactic form for creating pictures; the bit between the opening parenthesis with code is not an expression, but instead manipulated by the code syntactic form. This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax. Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isnt exactly a language at all; its more of an idea for how to structure a language so that you can extend it or create entirely " (word '(font "Courier" size 5) "lang."))))
(define eqs (split-quad (block '(x-align center font "Equity Text B" size 10) "Foo-d" (word '(size 13) "og ") "and " (box) " Zu" (word-break '(nb "c" bb "k-")) "kerman's. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a new syntactic form for creating pictures; the bit between the opening parenthesis with code is not an expression, but instead manipulated by the code syntactic form. This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax. Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isnt exactly a language at all; its more of an idea for how to structure a language so that you can extend it or create entirely " (word '(font "Courier" size 5) "lang."))))
(define megs (split-quad (block '(size 10 font "Courier") "Meg is an ally.")))
(activate-logger quad-logger)
(define measure 40.0)
(map quad->string (wrap-first megs measure))
(map quad->string (wrap-best megs measure))
(set! measure 200.0)
(time (map quad->string (wrap-first eqs measure)))
(time (map quad->string (wrap-best eqs measure)))

@ -547,6 +547,10 @@
(define measure 40.0)
(map quad->string (wrap-first megs measure))
(map quad->string (wrap-best megs measure))
(set! measure 200.0)
(time (map quad->string (wrap-first eqs measure)))
(time (map quad->string (wrap-best eqs measure)))
#|
(define trials 1)
(time-repeat trials (let () (wrap-first megs 36) (void)))

Loading…
Cancel
Save