;;;; Planning first steps (written in zmacs)
#|
My goal is to resemble Sussman's SICM replacement of informal maths
with executable scheme
by replacing informal maths with executable zetalisp
(intended to later also be executable ACL2 APPLY$)

Taking present :keywords as true fluents
and entry lists as actions,
can we unlock a lock on some treasure?
|#

(setq *list*
 (list
  `(,(gensym 'unlock-1) (:treasure) (:lock-1 :key-1) (:treasure) fun1)
  `(,(gensym 'weild-lock-1) (:lock-1) () (:lock-1) fun2)
  `(,(gensym 'weild-key-1) (:key-1) () (:key-1) fun3)))

#|
The list entries are
(unique-mnemonic gives needs cants &rest implementing-functions)

Originally I was going to mandate using (symbol-function (car entry))
as atomic lambdas, but there is no particular reason to do that other
than maybe-clarity.

The functions, performed left to right are meant to consume
(caddr entry) and produce (cadr entry)
(NEEDS and GIVES)
; also CANTS = negative predicates

So UNLOCK-100xx
GIVES (:treasure), NEEDS (:lock-1 :key-1) and not having CANTS (:treasure)
and is performed (unimplemented) by a single (symbol-function 'fun1)


Now we need a way of chaining backwards from the goal condition (:treasure)
to an ordered list of functions that might implement that goal.

(or if the functions are unimplemented, hand-waving)


|#

(defun combinep (goal entry-1 entry-2) "
COMBINEP takes 
goal - a list of keywords being final target fluents. (:treasure)
entry-1 - an existing plan entry connoting an action like
(some-gensymXXXX (:produced :this) (:consumed :this) (:cant :have :this)
 function-name-1 function-name-2 called-left to-right performs-this)
Mnemonically:
(MNEMS GIVES NEEDS CANTS &rest IMPLS)

The result is NIL or a list containing one new entry, representing
ENTRY-2 followed by ENTRY-1
with ENTRY-2's GIVES and ENTRY-1's NEEDS cancelled out.

Non-nil if
(and (or intersection-GIVES-and-GOALS-increased
         entry-1-NEEDS-reduced)
 cants-not-violated)
"
 (when (or (> (length (intersection goal (append (cadr entry-1) (cadr entry-2))))
             (length (intersection goal (cadr entry-1))))
          (< (length (set-difference (caddr entry-1) (cadr entry-2)))
            (length (caddr entry-1))))
  (unless (intersection (cadddr entry-1) (append (cadr entry-2) (caddr entry-2)))
   (cons
    (append
     (list (gensym)
      (set-difference (append (cadr entry-1) (cadr entry-2)) (caddr entry-1))
      (append (set-difference (caddr entry-1) (cadr entry-2)) (caddr entry-2)) ;typo
      (append (cadddr entry-1) (cadddr entry-2)))
     (cddddr entry-2)
     (cddddr entry-1))
    nil))))

#|
lets try it out!
(load "foo.lisp")
;; Sorry about the name. The lispm also changed default directory here for me.

(combinep '(:treasure) (car *list*) (caddr *list*))

NO FUNCTION NAMED SET-DIFFEREN <many options>
;; Whoops, typo.
meta-C (replace SET-DIFFEREN with the return of something I type)
super-A (resume)
;; Form returning replacement:
#'SET-DIFFERENCE

((#:WEILD-KEY-10109 (:TREASURE) (:LOCK-1) (:TREASURE :KEY-1) FUN3 FUN1))

So with a live hot-fix, my function composed WEILD-KEY and UNLOCK
to produce a new entry that GIVES (:treasure) but still NEEDS (:lock-1)
and CANTS be called if you already "hold" :treasure or :key-1.

The action is supposedly implemented by calling (symbol-function 'fun3)
followed by (symbol-function 'fun1).

The so-called frame problem is visible- what's the state of :lock
after the action unlock has happened? But also who cares.

CANTS seems like kind of a hack, kind of like a less strict once-only.

I'm using LISTs and not STRUCTs as a record type, since I may want to
investigate complex entry later, say using #'MEMQ FUN1 to extract
a list of function names starting with MEMQ, or pass entry LISTs as
list arguments to FORMAT or several of them to MAPCAR, and it would
be obtuse to manually handle structs into those LIST functions.

Differences to Sussman's SCHEMEs.

While I go out of my way to use cadr .. cddddr instead of NTH for
example, more on this in a moment, in general I jump in at a much
higher level than I think is idiomatic in most schemes-
I go straight to using zetalisp's optimised SET-DIFFERENCE and	;
INTERSECTION on LISTs.

We get a cultural opinion out of the MIT AI lab in the 70s that these
were tools other people had created and found to mostly cover low
level operations (and have been hand-optimized).

This isn't hand-waving, since these are DESCRIBEd and documented
front and centre, can be GRINDed into our own redefinition and
replaced as we like. It's simply a cultural gift from some hackers
to future hackers.


I'm calling this a semi-successful joining of the MIT AI LAB of the
70s/80s and now also 20s.

For the planner, it still needs an engine. I'm going to use the LOOP
facility NCONCing over quantile subsequences of tricky #'SORTs of
*list* TO GENERATIONALY EXTEND AND RANK *list*.

I didn't get to CHAOSNET yet. Maybe the day is still young, or I
can borrow an extended July 16th from the northern hemisphere...

Thanks for #OldComputerChallenge everyone!

When I rejoin the future, I am going to increasingly focus on
(on the web) lemmy.sdf.org/c/gopher !

See everyone here and there. Maybe a CHAOSNET discovery later
today.
|#







#| GENERATION |#

(defun one-generation (sharplessp stasta stasto stosta stosto) "
setqs *list* by #'SORT by sharplessp
then LOOP once-over each to create new actions
composing stasta..stasto onto stosta..stosto

*list* and *goal* are meant to be special. The idea is to have one of
your lisps dedicated to the search; so it would be dumb to pass the
only thing this would sensibly target to it as an argument

EXPERIMENTAL THEORY

returns *list*, destructive.
"
 (setq *list*
  (nconc *list*
   (loop initially (setq *list* (sort *list* sharplessp))
    for inner-item in (subseq *list* stasta stasto) nconcing
    (loop for outer-item in (subseq *list* stosta stosto)
     for new-item = (combinep *goal* inner-item outer-item)
     when new-item nconc new-item)))))

(defun compare-lengths (a b)
 (> (length a) (length b)))