dwolter_SparQ/Calculi/revised-star-calculus.lisp
;;; 
;;; Revised Star Calculus with 4*2 half-open sectors
;;;

(def-calculus "Star"
  :arity :binary
  :parametric? nil
  :basis-entity :2d-point
  :identity-relation ID
  :consistency :a-closure ;; changed for demo
  :converse-operation ((ID ID)
		       (0 4)
		       (1 5)
		       (2 6)
		       (3 7)
		       (4 0)
		       (5 1)
		       (6 2)
		       (7 3))
  
  :base-relations (ID 0 1 2 3 4 5 6 7)
  :qualifier #'(lambda (p1 p2)
		 (let* ((x1 (first p1)) (y1 (second p1))
			(x2 (first p2)) (y2 (second p2))
			(dx (- x2 x1))	 (dy (- y2 y1))
			(phi (/ pi 4)))
		   (labels ((rotate (phi x y)
			      (list (- (* (cos phi) x) (* (sin phi) y)) (+ (* (sin phi) x) (* (cos phi) y)))))
		     (if (and (= dx 0) (= dy 0))
			 'ID
			 (do ((x dx (first (rotate phi x y)))
			      (y dy (second (rotate phi x y)))
			      (i 0 (incf i)))
			     ((and (<= (first (rotate phi x y)) 0) (> x 0)) i)))))) 
  :composition-operation (
			  (ID ID ID) 
			  (ID 0 0) 
			  (ID 1 1) 
			  (ID 2 2) 
			  (ID 3 3) 
			  (ID 4 4) 
			  (ID 5 5) 
			  (ID 6 6) 
			  (ID 7 7) 
			  (0 ID 0) 
			  (1 ID 1) 
			  (2 ID 2) 
			  (3 ID 3) 
			  (4 ID 4) 
			  (5 ID 5) 
			  (6 ID 6) 
			  (7 ID 7) 
			  (0 0 0) 
			  (0 1 (0 1)) 
			  (0 2 (0 1 2)) 
			  (0 3 (0 1 2 3)) 
			  (0 4 (ID 0 1 2 3 4 5 6 7)) 
			  (0 5 (5 6 7 0)) 
			  (0 6 (6 7 0)) 
			  (0 7 (7 0)) 
			  (1 0 (0 1)) 
			  (1 1 1) 
			  (1 2 (1 2)) 
			  (1 3 (1 2 3)) 
			  (1 4 (1 2 3 4)) 
			  (1 5 (ID 0 1 2 3 4 5 6 7)) 
			  (1 6 (6 7 0 1)) 
			  (1 7 (7 0 1)) 
			  (2 0 (0 1 2)) 
			  (2 1 (1 2)) 
			  (2 2 2) 
			  (2 3 (2 3)) 
			  (2 4 (2 3 4)) 
			  (2 5 (2 3 4 5)) 
			  (2 6 (ID 0 1 2 3 4 5 6 7)) 
			  (2 7 (7 0 1 2)) 
			  (3 0 (0 1 2 3)) 
			  (3 1 (1 2 3)) 
			  (3 2 (2 3)) 
			  (3 3 3) 
			  (3 4 (3 4)) 
			  (3 5 (3 4 5)) 
			  (3 6 (3 4 5 6)) 
			  (3 7 (ID 0 1 2 3 4 5 6 7)) 
			  (4 0 (ID 0 1 2 3 4 5 6 7)) 
			  (4 1 (1 2 3 4)) 
			  (4 2 (2 3 4)) 
			  (4 3 (3 4)) 
			  (4 4 4) 
			  (4 5 (4 5)) 
			  (4 6 (4 5 6)) 
			  (4 7 (4 5 6 7)) 
			  (5 0 (5 6 7 0)) 
			  (5 1 (ID 0 1 2 3 4 5 6 7)) 
			  (5 2 (2 3 4 5)) 
			  (5 3 (3 4 5)) 
			  (5 4 (4 5)) 
			  (5 5 5) 
			  (5 6 (5 6)) 
			  (5 7 (5 6 7)) 
			  (6 0 (6 7 0)) 
			  (6 1 (6 7 0 1)) 
			  (6 2 (ID 0 1 2 3 4 5 6 7)) 
			  (6 3 (3 4 5 6)) 
			  (6 4 (4 5 6)) 
			  (6 5 (5 6)) 
			  (6 6 6) 
			  (6 7 (6 7)) 
			  (7 0 (7 0)) 
			  (7 1 (7 0 1)) 
			  (7 2 (7 0 1 2)) 
			  (7 3 (ID 0 1 2 3 4 5 6 7)) 
			  (7 4 (4 5 6 7)) 
			  (7 5 (5 6 7)) 
			  (7 6 (6 7)) 
			  (7 7 7)
			  )
  :cnhs ( ( (default def)
            ((ID (0 1 2 3 4 5 6 7))
             (0 (ID 7 1))
             (1 (ID 0 2))
             (2 (ID 1 3))
             (3 (ID 2 4))
             (4 (ID 3 5))
             (5 (ID 4 6))
             (6 (ID 5 7))
             (7 (ID 6 0))
            )
          )
        )

  )




