diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 0bf3381c..1ed991de 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -29,8 +29,8 @@ (define variable (car variables)) (define domain (hash-ref domains variable)) (set-field! _list domain - (for/fold ([domain-values (send domain get-values)]) - ([value (in-list (send domain get-values))] + (for/fold ([domain-values (domain)]) + ([value (in-list (domain))] #:when (not (call variables domains (make-hash (list (cons variable value)))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) @@ -48,12 +48,12 @@ [(= (length unassigned-variables) 1) (define unassigned-variable (car unassigned-variables)) (define unassigned-variable-domain (hash-ref domains unassigned-variable)) - (for ([value (in-list (send unassigned-variable-domain get-values))]) + (for ([value (in-list (unassigned-variable-domain))]) (hash-set! assignments unassigned-variable value) (when (not (call variables domains assignments)) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) - (not (send unassigned-variable-domain values-empty?))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])) )) @@ -94,9 +94,9 @@ [(and forward-check? (for*/or ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))] [assigned-value (in-list assigned-values)] - #:when (send unassigned-var-domain contains-value? assigned-value)) + #:when (member assigned-value (unassigned-var-domain))) (send unassigned-var-domain hide-value assigned-value) - (send unassigned-var-domain values-empty?))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (null? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])))) (define all-different-constraint%? (is-a?/c all-different-constraint%)) @@ -125,10 +125,10 @@ (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (set! domain (hash-ref domains variable)) - (when (not (singlevalue . in? . (send domain get-values))) + (when (not (singlevalue . in? . (domain))) (set! return-value #f) (return-k)) - (for ([value (in-list (send domain get-values))]) + (for ([value (in-list (domain))]) (when (not (equal? value singlevalue)) (send domain hide-value value)))))) (set! return-value #t) diff --git a/csp/domain.rkt b/csp/domain.rkt index 3242939e..a9063e6f 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -2,12 +2,18 @@ (require racket/class racket/list "helper.rkt") (provide (all-defined-out)) -(define domain% - ;; Class used to control possible values for variables - ;; When list or tuples are used as domains, they are automatically - ;; converted to an instance of that class. - - (class* object% (printable<%>) +(define proc<%> + (interface* () + ([prop:procedure + (λ(this) + (send this get-values))]) + get-values)) + +;; Class used to control possible values for variables +;; When list or tuples are used as domains, they are automatically +;; converted to an instance of that class. +(define domain% + (class* object% (printable<%> proc<%>) (super-new) (init-field set) (field [_list set][_hidden null][_states null]) @@ -51,12 +57,6 @@ (define/public (get-values) _list) - (define/public (values-empty?) - (null? _list)) - - (define/public (contains-value? value) - (member value _list)) - (define/public (domain-pop!) (py-pop! _list)) @@ -64,9 +64,7 @@ (define copied-domain (new domain% [set _list])) (set-field! _hidden copied-domain _hidden) (set-field! _states copied-domain _states) - copied-domain) - - - )) + copied-domain))) + (define domain%? (is-a?/c domain%)) diff --git a/csp/problem.rkt b/csp/problem.rkt index d94e8459..852b795a 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -3,9 +3,8 @@ (require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) -(define/contract problem% - ;; Class used to define a problem and retrieve solutions - +;; Class used to define a problem and retrieve solutions +(define/contract problem% (class/c [reset (->m void?)] [set-solver (solver%? . ->m . void?)] [get-solver (->m solver%?)] @@ -52,7 +51,7 @@ (define domain (if (domain%? domain-or-values) (send domain-or-values copy) (new domain% [set domain-or-values]))) - (when (send domain values-empty?) + (when (null? (domain)) (error 'add-variable "domain value is null")) (hash-set! _variable-domains variable domain)) @@ -114,6 +113,6 @@ (if (for/or ([domain (in-hash-values variable-domains)]) (send domain reset-state) - (send domain values-empty?)) + (null? (domain))) (values null null null) (values variable-domains constraints vconstraints))))) \ No newline at end of file