77 lines
2.0 KiB
Plaintext
77 lines
2.0 KiB
Plaintext
(deftemplate longest
|
|
(slot bound) ; upper bound for the range of values to check
|
|
(slot next (default 2)) ; next value that needs to be checked
|
|
(slot start (default 1)) ; starting value of longest sequence
|
|
(slot len (default 1)) ; length of longest sequence
|
|
)
|
|
|
|
(deffacts startup
|
|
(query 27)
|
|
(longest (bound 100000))
|
|
)
|
|
|
|
(deffunction hailstone-next
|
|
(?n)
|
|
(if (evenp ?n)
|
|
then (div ?n 2)
|
|
else (+ (* 3 ?n) 1)
|
|
)
|
|
)
|
|
|
|
(defrule extend-sequence
|
|
?hail <- (hailstone $?sequence ?tail&:(> ?tail 1))
|
|
=>
|
|
(retract ?hail)
|
|
(assert (hailstone ?sequence ?tail (hailstone-next ?tail)))
|
|
)
|
|
|
|
(defrule start-query
|
|
(query ?num)
|
|
=>
|
|
(assert (hailstone ?num))
|
|
)
|
|
|
|
(defrule result-query
|
|
(query ?num)
|
|
(hailstone ?num $?sequence 1)
|
|
=>
|
|
(bind ?sequence (create$ ?num ?sequence 1))
|
|
(printout t "Hailstone sequence starting with " ?num ":" crlf)
|
|
(bind ?len (length ?sequence))
|
|
(printout t " Length: " ?len crlf)
|
|
(printout t " First four: " (implode$ (subseq$ ?sequence 1 4)) crlf)
|
|
(printout t " Last four: " (implode$ (subseq$ ?sequence (- ?len 3) ?len)) crlf)
|
|
(printout t crlf)
|
|
)
|
|
|
|
(defrule longest-create-next-hailstone
|
|
(longest (bound ?bound) (next ?next))
|
|
(test (<= ?next ?bound))
|
|
(not (hailstone ?next $?))
|
|
=>
|
|
(assert (hailstone ?next))
|
|
)
|
|
|
|
(defrule longest-check-next-hailstone
|
|
?longest <- (longest (bound ?bound) (next ?next) (start ?start) (len ?len))
|
|
(test (<= ?next ?bound))
|
|
?hailstone <- (hailstone ?next $?sequence 1)
|
|
=>
|
|
(retract ?hailstone)
|
|
(bind ?thislen (+ 2 (length ?sequence)))
|
|
(if (> ?thislen ?len) then
|
|
(modify ?longest (start ?next) (len ?thislen) (next (+ ?next 1)))
|
|
else
|
|
(modify ?longest (next (+ ?next 1)))
|
|
)
|
|
)
|
|
|
|
(defrule longest-finished
|
|
(longest (bound ?bound) (next ?next) (start ?start) (len ?len))
|
|
(test (> ?next ?bound))
|
|
=>
|
|
(printout t "The number less than " ?bound " that has the largest hailstone" crlf)
|
|
(printout t "sequence is " ?start " with a length of " ?len "." crlf)
|
|
(printout t crlf)
|
|
)
|