Skip to content

Commit 13d83df

Browse files
samwondimsamwondim
authored
Merge pull request #27 from Tesfalegnp/chore/allTestedActions
Chore/all tested actions
2 parents 25fe043 + f72fca4 commit 13d83df

File tree

1 file changed

+115
-123
lines changed

1 file changed

+115
-123
lines changed

‎main/planning/action-planner.metta

Lines changed: 115 additions & 123 deletions
Original file line numberDiff line numberDiff line change
@@ -1,123 +1,115 @@
1-
!(bind! np (py-atom numpy))
2-
!(bind! &testedActions (new-space))
3-
4-
(= (TestedActions) &testedActions)
5-
6-
(= (hillClimbingPlanner $initialState $goal $testedActions $plan $ruleSpace)
7-
(if (== $initialState $goal) ;if thecurrent state is the goal or a path from $initalState to $goal has been found, return the plan.
8-
$plan
9-
(let* (
10-
($tested (getTestedActions $initialState $testedActions)) ;query tested actions for initialState.
11-
($applicableActions (collapse (match $ruleSpace
12-
(: $handle (IMPLICATION_LINK (AND_LINK (($initialState) $action)) $g))
13-
$action))) ;get applicable actions and.
14-
($untriedActions (filterUntriedRules $applicableActions $tested () )) ;Filter out the ones that already have been tested.
15-
;(() (println! ( tested --> $tested untried --> $untriedActions applicable --> $applicableActions plan --> $plan)))
16-
)
17-
(if (== $untriedActions ()) ;No untested actions, return () to back
18-
()
19-
(let* (
20-
($newStates (applyActions $untriedActions $initialState () $ruleSpace)) ;Apply all actions to get new states.
21-
(($minDistance $bestPair) (findMinDistance $newStates $goal 1000 () $ruleSpace)) ;find the least distance among the new states.
22-
($currentDistance (distance $initialState $goal $ruleSpace))
23-
($bestAction (car-atom $bestPair))
24-
($bestState (cadr-atom $bestPair))
25-
;(() (println! (new-stateus (bestAction $bestAction) (appActions $newStates) (currState $initialState)
26-
;(plan $plan) (currDistance $currentDistance) (minDis $minDistance))))
27-
)
28-
(if (>= $currentDistance $minDistance)
29-
(let () (update-atom $testedActions ($initialState $bestAction) ($bestState $bestAction))
30-
(hillClimbingPlanner $bestState $goal $testedActions (cons-atom $bestAction $plan) $ruleSpace) ;recursively explore the best state
31-
)
32-
;No improvement, mark all untried actions as tested and return () to backtrack
33-
(let $res (allTested $untriedActions $tested) (let $m (markAllTested $initialState $untriedActions $testedActions) ()))
34-
)
35-
)
36-
)
37-
)
38-
)
39-
)
40-
41-
(= (distance $current $goal $ruleSpace)
42-
(let* (
43-
($x (- (goal-value $goal $ruleSpace) (goal-value $current $ruleSpace)))
44-
($y (- (desired-goal-value $goal $ruleSpace) (desired-goal-value $current $ruleSpace)))
45-
)
46-
(+ $x $y)
47-
)
48-
)
49-
50-
(= (applyActions $actions $goal $acc $ruleSpace)
51-
(if (== $actions ())
52-
$acc
53-
(let* (
54-
(($head $tail) (decons-atom $actions))
55-
($res (collapse (match $ruleSpace (: $handle (IMPLICATION_LINK (AND_LINK (($goal) $head)) $g) ) ($head $g))))
56-
($rest (applyActions $tail $goal (concatTuple $res $acc) $ruleSpace))
57-
;(() (println! (appAc $res )))
58-
)
59-
(if (== $head ())
60-
(concatTuple $acc $res)
61-
$rest
62-
)
63-
)
64-
)
65-
)
66-
67-
(= (filterUntriedRules $actions $tested $acc)
68-
(if (== $actions ())
69-
$acc
70-
(let ($head $tail) (decons-atom $actions)
71-
(if (isMember $head $tested)
72-
(filterUntriedRules $tail $tested $acc)
73-
(filterUntriedRules $tail $tested (cons-atom $head $acc))
74-
)
75-
)
76-
)
77-
)
78-
79-
(= (findMinDistance $newStates $goal $minDistance $bestPair $ruleSpace)
80-
(if (== $newStates ())
81-
($minDistance $bestPair)
82-
(let* (
83-
((($action $state) $tail) (decons-atom $newStates))
84-
($dist (distance $state $goal $ruleSpace))
85-
)
86-
(if (< $dist $minDistance)
87-
(findMinDistance $tail $goal $dist ($action $state) $ruleSpace)
88-
(findMinDistance $tail $goal $minDistance $bestPair $ruleSpace)
89-
)
90-
)
91-
)
92-
)
93-
94-
(= (allTested $actions $tested)
95-
(if (== $actions ())
96-
$tested
97-
(let ($head $tail) (decons-atom $actions)
98-
(if (isMember $head $tested)
99-
(allTested $tail $tested)
100-
(allTested $tail (cons-atom $head $tested))
101-
)
102-
)
103-
)
104-
)
105-
106-
(= (markAllTested $state $list $space)
107-
(if (== $list ())
108-
()
109-
(let* (
110-
($head (car-atom $list))
111-
($tail (cdr-atom $list))
112-
)
113-
(if (== $head ())
114-
()
115-
(let () (add-atom $space ($state $head)) (markAllTested $state $tail $space))
116-
)
117-
)
118-
)
119-
)
120-
121-
(= (getTestedActions $key $space)
122-
(collapse (match $space ($key $action) $action))
123-
)
1+
!(bind! np (py-atom numpy))
2+
!(bind! &testedActions (new-space))
3+
4+
(= (TestedActions) &testedActions)
5+
6+
(= (hillClimbingPlanner $initialState $goal $testedActions $plan $ruleSpace)
7+
(if (== $initialState $goal) ;if thecurrent state is the goal or a path from $initalState to $goal has been found, return the plan.
8+
$plan
9+
(let* (
10+
($tested (getTestedActions $initialState $testedActions)) ;query tested actions for initialState.
11+
($applicableActions (collapse (match $ruleSpace
12+
(: $handle (IMPLICATION_LINK (AND_LINK (($initialState) $action)) $g))
13+
$action))) ;get applicable actions and.
14+
($untriedActions (filterUntriedRules $applicableActions $tested () )) ;Filter out the ones that already have been tested.
15+
;(() (println! ( tested --> $tested untried --> $untriedActions applicable --> $applicableActions plan --> $plan)))
16+
)
17+
(if (== $untriedActions ()) ;No untested actions, return () to back
18+
()
19+
(let* (
20+
($newStates (applyActions $untriedActions $initialState () $ruleSpace)) ;Apply all actions to get new states.
21+
(($minDistance $bestPair) (findMinDistance $newStates $goal 1000 () $ruleSpace)) ;find the least distance among the new states.
22+
($currentDistance (distance $initialState $goal $ruleSpace))
23+
($bestAction (car-atom $bestPair))
24+
($bestState (cadr-atom $bestPair))
25+
;(() (println! (new-stateus (bestAction $bestAction) (appActions $newStates) (currState $initialState)
26+
;(plan $plan) (currDistance $currentDistance) (minDis $minDistance))))
27+
)
28+
(if (>= $currentDistance $minDistance)
29+
(let () (update-atom $testedActions ($initialState $bestAction) ($bestState $bestAction))
30+
(hillClimbingPlanner $bestState $goal $testedActions (cons-atom $bestAction $plan) $ruleSpace) ;recursively explore the best state
31+
)
32+
;No improvement, mark all untried actions as tested and return () to backtrack
33+
(let $res (allTested $untriedActions $tested) (let $m (markAllTested $initialState $untriedActions $testedActions) ()))
34+
)
35+
)
36+
)
37+
)
38+
)
39+
)
40+
41+
(= (distance $current $goal $ruleSpace)
42+
(let* (
43+
($x (- (goal-value $goal $ruleSpace) (goal-value $current $ruleSpace)))
44+
($y (- (desired-goal-value $goal $ruleSpace) (desired-goal-value $current $ruleSpace)))
45+
)
46+
(+ $x $y)
47+
)
48+
)
49+
50+
(= (applyActions $actions $goal $acc $ruleSpace)
51+
(if (== $actions ())
52+
$acc
53+
(let* (
54+
(($head $tail) (decons-atom $actions))
55+
($res (collapse (match $ruleSpace (: $handle (IMPLICATION_LINK (AND_LINK (($goal) $head)) $g) ) ($head $g))))
56+
($rest (applyActions $tail $goal (concatTuple $res $acc) $ruleSpace))
57+
;(() (println! (appAc $res )))
58+
)
59+
(if (== $head ())
60+
(concatTuple $acc $res)
61+
$rest
62+
)
63+
)
64+
)
65+
)
66+
67+
(= (filterUntriedRules $actions $tested $acc)
68+
(if (== $actions ())
69+
$acc
70+
(let ($head $tail) (decons-atom $actions)
71+
(if (isMember $head $tested)
72+
(filterUntriedRules $tail $tested $acc)
73+
(filterUntriedRules $tail $tested (cons-atom $head $acc))
74+
)
75+
)
76+
)
77+
)
78+
79+
(= (findMinDistance $newStates $goal $minDistance $bestPair $ruleSpace)
80+
(if (== $newStates ())
81+
($minDistance $bestPair)
82+
(let* (
83+
((($action $state) $tail) (decons-atom $newStates))
84+
($dist (distance $state $goal $ruleSpace))
85+
)
86+
(if (< $dist $minDistance)
87+
(findMinDistance $tail $goal $dist ($action $state) $ruleSpace)
88+
(findMinDistance $tail $goal $minDistance $bestPair $ruleSpace)
89+
)
90+
)
91+
)
92+
)
93+
94+
(= (allTested $actions $tested)
95+
(let $res (union-atom $actions $tested) (unique-atom $res))
96+
)
97+
98+
(= (markAllTested $state $list $space)
99+
(if (== $list ())
100+
()
101+
(let* (
102+
($head (car-atom $list))
103+
($tail (cdr-atom $list))
104+
)
105+
(if (== $head ())
106+
()
107+
(let () (add-atom $space ($state $head)) (markAllTested $state $tail $space))
108+
)
109+
)
110+
)
111+
)
112+
113+
(= (getTestedActions $key $space)
114+
(collapse (match $space ($key $action) $action))
115+
)

0 commit comments

Comments
 (0)