How can I stablish a relation between two LHS in clips? - logic

I'm trying to make a clips program in order to solve any Sokoban level but I have a huge problem:
In this example, I only have the initial state of the field and a rule which tries to move the player to the right if there is not a box or an obstacle (in the full program I also have rules which move the boxes). The problem comes when I have a state which matches with the LHS ?ff <- (R ?Ir ?Xr ?Yr $?a B ?Ib ?Xb ?Yb $?b S ?Is ?Xs ?Ys ?Es $?c W ?w D ?d L ?l F ?) and another one, created due to the movement of the boxes, which does not allow the rule (not (R $? B ? =(+ ?Xr 1) ?Yr $?) ) to be true even if the first estate makes it true.
(deffacts InitialState
;------static---------
(MAX_DEPTH 5)
;field
; X Y
(FIELD 8 5)
;obstacle
; X Y
(O 4 1)
(O 1 3)
(O 8 3)
(O 4 3)
(O 5 3)
(O 4 4)
(O 4 5)
;-----dynamic-----
(
;robot
; I X Y
R 1 2 4
;box
; I X Y
B 1 2 2
B 2 3 4
B 3 6 2
;storehouse
; I X Y E
S 1 7 1 0
S 2 5 4 0
S 3 5 5 0
;win
W 0 ;Posibilidad de cambiar la R por W asi paramos la ejec
; depth
D 0
;last move
;0:nothing 1:up 2:right 3:down 4:left
L 0
;father id
F 0
)
)
(defrule move_right_no_box
(MAX_DEPTH ?MD)
(FIELD ?Xf ?Yf)
?ff <- (R ?Ir ?Xr ?Yr $?a B ?Ib ?Xb ?Yb $?b S ?Is ?Xs ?Ys ?Es $?c W ?w D ?d L ?l F ?)
;comprueba que a la derecha no hay un obstacle
(not (O =(+ ?Xr 1) ?Yr) )
;comprueba que a la derecha no hay un box
(not (R $? B ? =(+ ?Xr 1) ?Yr $?) )
=>
(assert (R ?Ir (+ ?Xr 1) ?Yr $?a B ?Ib ?Xb ?Yb $?b S ?Is ?Xs ?Ys ?Es $?c W ?w D (+ ?d 1) L 2 F ?ff))
)
For example, I have a state which do not have a box or an obstacle in the right, but I have another state which does. I need a way to establish a relation between the rules:
?ff <- (R ?Ir ?Xr ?Yr $?a B ?Ib ?Xb ?Yb $?b S ?Is ?Xs ?Ys ?Es $?c W ?w D ?d L ?l F ?) and (not (R $? B ? =(+ ?Xr 1) ?Yr $?) ) in order to make sure that they are referring to the same state (and a different state, which is different from the one that I'm evaluating, is not interfering).
I other words, what I need is a way to make sure that both LHS are evaluating the same state.
Thanks!
PD1: I can't use something like an ID because it makes the execution of the program too slow.

Assert a fact containing information about the state that both rules match.

Okay, at the end I could not found a way to make sure that two LHS are evaluating the same state, so I solved the problem using the 'member' function: https://www.csie.ntu.edu.tw/~sylee/courses/clips/bpg/node12.2.3.html
I can create a LHS rule which always returns True and is composed of multifield variables and then using the member function check if part of the rule satisfies my condition.
Another option (even if I'm not sure this works due to I have not tested it) is to evaluate all the conditions in one LHS using this:
https://www.csie.ntu.edu.tw/~sylee/courses/clips/bpg/node5.4.1.4.html

Related

Find all facts matching a condition in Defrule

I have two type of facts: state1 and state2, both are arrays of numbers. I want to check if a fact with tag 'state' with current value of state2 variable exists. How can I do it?
For example, if now facts are:
State 1 2 3
State2 4 5 6
State 0 8 9,
And current state2 is 1 2 3, I want to get into RHS because first row 'State 1 2 3' matches current value of State2.
I tried following solution, but I never enter RHS.
;;; END FUNCTION, EXECUTES WHEN SOLUTION WAS FOUND
(defrule complete (declare (salience 1000))
(exists (state ?state2))
=> (printout t "Target state [1 2 3 8 0 4 7 6 5] reached" crlf) (halt)
);
CLIPS (6.31 6/12/19)
CLIPS>
(defrule complete
(exists (state $?state)
(state2 $?state))
=>
(printout t "Target state [1 2 3 8 0 4 7 6 5] reached" crlf))
CLIPS>
(assert
(state 1 2 3)
(state2 4 5 6)
(state 0 8 9)
(state2 1 2 3))
<Fact-4>
CLIPS> (agenda)
0 complete: *
For a total of 1 activation.
CLIPS> (run)
Target state [1 2 3 8 0 4 7 6 5] reached
CLIPS>

I'm not sure why this simple code does not work

I want someone to enter number "1", "2", or "3", and if the number is correct, want to say "ok". If not, I want to say "enter 1 or 2 or 3".
This is my code:
puts "enter 1 or 2 or 3"
num = gets.to_i
if num == 1 or 2 or 3
puts "ok"
else
puts "enter 1 or 2 or 3"
end
When I enter an incorrect answer such as "e" or "p", it still says "ok".
Why is it the case?
Let's first examine why you are obtaining incorrect results.
If a equals false or nil (is falsy, meaning logically false), a or b returns the value of b. If a equals any other value (is truthy, meaning logically true), a or b returns a.
Suppose we have an expression a op1 b op2 c, where op1 and op2 are operators (e.g., a == b or c). This could be evaluated (a op1 b) op2 c or a op1 (b op2 c), where parentheses have the highest precedence.
The precedence of Ruby's operators (most implemented as methods) is given here. Note that == has higher precedence than or. Moreover, for any given operator op, a op b op c is evaluated (a op b) op c.
The expression num == 1 or 2 or 3 is therefore evaluated
((num == 1) or 2) or 3
Now consider the value of this expression, depending on the value of num.
num = 1
((num == 1) or 2) or 3 => (true or 2) or 3 => true or 3 => true
num != 1
((num == 1) or 2) or 3 => (false or 2) or 3 => 2 or 3 => 2
Here are some ways to obtain your desired result.
(num == 1) or (num == 2) or (num == 3)
(num == 1) || (num == 2) || (num == 3)
[1, 2, 3].include?(num)
[1, 2, 3] & [num] == [num]
([num] - [1, 2, 3]).empty?
Because of the precedence rules for operators, the parentheses are not needed in the first two expressions, but it can be argued they clarify the code, at least for some readers. (I would include them.)
Regarding the choice between using or or ||, see this SO queston, particularly the second answer. In practice, or is rarely used.
See Array#include?, Array#& and Array#-.
To round out the possibilities, one could conceivably use a case statement.
case num
when 1, 2, 3 then true
else false
end
If, as here, the acceptable values of num form a range, one could write either of the following.
num.between?(1, 3)
(1..3).cover?(num)
(num >= 1) && (num <= 3)
See Comparable#between and Range#cover?. Again, the parentheses in the latter are optional.
In your code, num == 1 or 2 or 3 evaluates to true always, as 2 is considered logically true, and using an or`` operator with logically true value returns atrue` result always.
The correct way to compare is like this
puts "enter 1 or 2 or 3"
num = gets.to_i
if num == 1 or num == 2 or num == 3
puts "ok"
else
puts "enter 1 or 2 or 3"
end
Here, you are comparing the value of variable with right literal.

Trying to create an efficient algorithm for a function in Haskell

I'm looking for an efficient polynomial-time solution to the following problem:
Implement a recursive function node x y for calculating the (x,y)-th number in a number triangle defined as
g(x,y) = 0 if |x| > y
= 1 if (x,y) = (0,0)
= sum of all incoming paths otherwise
The sum of all incoming paths to a node is defined as the sum of the values of all possible paths from the root node (x, y) = (0, 0) to the node under consideration, where at each node (x,y) a path can either continue diagonally down and left (x−1,y+1), straight down (x,y+1), or diagonally down and right (x+1,y+1). The value of a path to a node is defined as the sum of all the nodes along that path up to, but not including, the node under consideration.
The first few entries in the number triangle are given in the table:
\ x -3 -2 -1 0 1 2 3
\
y \ _________________________
|
0 | 0 0 0 1 0 0 0
|
1 | 0 0 1 1 1 0 0
|
2 | 0 2 4 6 4 2 0
|
3 | 4 16 40 48 40 16 4
I am trying to work out a naive solution first, here is what I have:
node x y | y < 0 = error "number cannot be negative"
| (abs x) > y = 0
| (x == 0) && (y == 0) = 1
| otherwise = node (x+1) (y-1) + node x (y-1) + node (x-1) (y-1)
Whenever I run this I get:
"* Exception: stack overflow"?
I believe your problem is a bit more complicated than your example code suggests. First, let's be clear about some definitions here:
Let pathCount x y be the number of paths that end at (x, y). We have
pathCount :: Int -> Int -> Integer
pathCount x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]
Now let's pathSum x y be the sum of all paths that end in (x, y). We have:
pathSum :: Int -> Int -> Integer
pathSum x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
| d <- [-1..1] ]
With this helper, we can finally define node x y properly:
node :: Int -> Int -> Integer
node x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]
This algorithm as such is exponential time in its current form. We can however add memoization to make the number of additions quadratic. The memoize package on Hackage makes this easy as pie. Full example:
import Control.Monad
import Data.List (intercalate)
import Data.Function.Memoize (memoize2)
node' :: Int -> Int -> Integer
node' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) | d <- [-1..1]]
node = memoize2 node'
pathCount' :: Int -> Int -> Integer
pathCount' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathCount (x + d) (y - 1) | d <- [-1..1]]
pathCount = memoize2 pathCount'
pathSum' :: Int -> Int -> Integer
pathSum' x y
| y == 0 = if x == 0 then 1 else 0
| otherwise = sum [ pathSum (x + d) (y - 1) + node x y * pathCount (x + d) (y - 1)
| d <- [-1..1] ]
pathSum = memoize2 pathSum'
main =
forM_ [0..n] $ \y ->
putStrLn $ intercalate " " $ map (show . flip node y) [-n..n]
where n = 5
Output:
0 0 0 0 0 1 0 0 0 0 0
0 0 0 0 1 1 1 0 0 0 0
0 0 0 2 4 6 4 2 0 0 0
0 0 4 16 40 48 40 16 4 0 0
0 8 72 352 728 944 728 352 72 8 0
16 376 4248 16608 35128 43632 35128 16608 4248 376 16
As you can see the algorithm the size of the numbers will get out of hands rather quickly. So the runtime is not O(n^2), while the number of arithmetic operations is.
You're thinking in terms of outgoing paths, when you should be thinking in terms of incoming paths. Your recursive step is currently looking for nodes from below, instead of above.
First of all, sorry if this is long. I wanted to explain the step by step thought process.
To start off with, you need one crucial fact: You can represent the "answer" at each "index" by a list of paths. For all the zeros, this is [[]], for your base case it is [[1]], and for example, for 0,2 it is [[6,1,1],[6,1,1],[6,1,1]]. This may seem like some redundancy, but it simplifies things down the road. Then, extracting the answer is head . head if the list is non empty, or const 0 if it is.
This is very useful because you can store the answer as a list of rows (the first row would be '[[1]], [], [] ...) and the results of any given row depend only on the previous row.
Secondly, this problem is symmetrical. This is pretty obvious.
The first thing we will do will mirror the definition of fib very closely:
type Path = [[Integer]]
triangle' :: [[Path]]
triangle' = ([[1]] : repeat []) : map f triangle'
We know this must be close to correct, since the 2nd row will depend on the first row only, the third on the 2nd only, etc. So the result will be
([[1]] : repeat []) : f ([[1]] : repeat []) : f ....
Now we just need to know what f is. Firstly, its type: [Path] -> [Path]. Quite simply, given the previous row, return the next row.
Now you may see another problem arising. Each invocation of f needs to know how many columns in the current row. We could actually count the length of non-null elements in the previous row, but it is simpler to pass the parameter directly, so we change map f triangle' to zipWith f [1..] triangle', giving f the type Int -> [Path] -> [Path].
f needs to handle one special case and one general case. The special case is x=0, in this case we simply treat the x+1,y-1 and x-1,y-1 recursions the same, and otherwise is identical to gn. Lets make two functions, g0 and gn which handle these two cases.
The actually computation of gn is easy. We know for some x we need the elements x-1, x, x+1 of the previous row. So if we drop x-1 elements before giving the previous row to the xth invocation of gn, gn can just take the first 3 elements and it will have what it needs. We write this as follows:
f :: Int -> [Path] -> [Path]
f n ps = g0 ps : map (gn . flip drop ps) [0..n-1] ++ repeat []
The repeat [] at the end should be obvious: for indices outside the triangle, the result is 0.
Now writing g0 and gs is really quite simple:
g0 :: [Path] -> Path
g0 (a:b:_) = map (s:) q
where
s = sum . concat $ q
q = b ++ a ++ b
gn :: [Path] -> Path
gn (a:b:c:_) = map (s:) q
where
s = sum . concat $ q
q = a ++ b ++ c
On my machine this version is about 3-4 times faster than the fastest version I could write with normal recursion and memoization.
The rest is just printing or pulling out the number you want.
triangle :: Int -> Int -> Integer
triangle x y = case (triangle' !! y) !! (abs x) of
[] -> 0
xs -> head $ head xs
triList :: Int -> Int -> Path
triList x y = (triangle' !! y) !! (abs x)
printTri :: Int -> Int -> IO ()
printTri width height =
putStrLn $ unlines $ map unwords
[[ p $ triangle x y | x <- [-x0..x0]] | y <- [0..height]]
where maxLen = length $ show $ triangle 0 height
x0 = width `div` 2
p = printf $ "%" ++ show maxLen ++ "d "

How do you find the definition of a function when all you have is a huge set of input/ouput pairs?

Suppose that you were given a list of input/ouput pairs:
f 0 = 0
f 1 = 2
f 2 = 1
f 3 = -1
f 4 = 0
f 5 = 0
f 6 = -76
f 7 = -3
f 8 = 3
f 9 = -1
f 10 = -1
f 11 = -6
f 12 = -1
f 13 = -1
f 14 = 4
f 15 = -2
f 16 = -10
f 17 = 0
f 18 = 0
f 19 = -1
f 20 = 2
f 21 = 3
f 22 = 0
f 23 = 4
f 24 = 2
f 25 = -1
f 26 = 0
f 27 = 0
f 28 = -4
f 29 = -2
f 30 = -14
Now suppose you were asked to find the definition of f using a proper, small mathematical formula instead of an enumeration of values. That is, the answer should be f x = floor(tan(x*x-3)) (or similar), because that is a small formula that is correct for every input. How would you do it?
So let's simplify. You want a function such that
f 1 = 10
f 2 = 3
f 3 = 8
There exists a formula for immediately finding a polynomial function which meets these demands. In particular
f x = 6 * x * x - 25 * x + 29
works. It turns out to be the case that if you have the graph of any function
{ (x_1, y_1), (x_2, y_2), ..., (x_i, y_i) }
you can immediately build a polynomial which exactly matches those inputs and outputs.
So, given that polynomials like this exist you're never going to solve your problem (finding a particular solution like floor(tan(x*x-3))) without enforcing more constraints. In particular, if you don't somehow outlaw or penalize polynomials then I'm always going to deliver them to you.
In general, what you'd like to do is (a) define a search space and (b) define a metric of fitness, also known as a loss function. If your search space is finite then you have yourself a solution immediately: rank every element of your search space according to your loss function and select randomly from the set of solutions which tie for best.
What it sounds like you're asking for is much harder though—if you're looking through the space of all possible programs then that space is unbelievably large. Searching it exhaustively is impossible unless we constrain ourselves heavily or accept approximation. Secondly, we must have very good understanding of your loss function and how it interacts with the search space as we'll want to make intelligent guesses to move forward through this vast space.
You mention genetic algorithms—they're often lauded for this kind of work and indeed they can be a method of driving search through a large space with an uncertain loss function, but they also fail as often as they succeed. Someone who is genuinely skilled at using genetic algorithms to solve problems will spend all of their time crafting the search space and the loss function to direct the algorithm toward meaningful answers.
Now this can be done for general programs if you're careful. In fact, this was the subject of last year's ICFP programming contest. In particular, search on this page for "Rules of the ICFP Contest 2013" to see the set up.
I think feed forward neural network (FFNN) and genetic programming (GP) are good techniques for complicated function simulation.
if you need function as polynomials use the GP otherwise FFNN is very simple and the matlab have a library for it.
I think the "interpolation" don't get what I am asking. Maybe I was not clear enough, but fortunately I've managed to get a semi-satisfactory answer to my question using a brute-force search algorithm myself. Using only a list of input/output pairs, as presented in the question, I was able to recover the original function. The comments on this snippet should explain it:
import Control.Monad.Omega
{- First we define a simple evaluator for mathematical expressions -}
data A = Add A A | Mul A A | Div A A | Sub A A | Pow A A |
Sqrt A | Tan A | Sin A | Cos A |
Num Float | X deriving (Show)
eval :: A -> Float -> Float
eval (Add a b) x = eval a x + eval b x
eval (Mul a b) x = eval a x * eval b x
eval (Div a b) x = eval a x / eval b x
eval (Sub a b) x = eval a x - eval b x
eval (Pow a b) x = eval a x ** eval b x
eval (Sqrt a) x = sqrt (eval a x)
eval (Tan a) x = tan (eval a x)
eval (Sin a) x = sin (eval a x)
eval (Cos a) x = cos (eval a x)
eval (Num a) x = a
eval X x = x
{- Now we enumerate all possible terms of that grammar -}
allTerms = do
which <- each [1..15]
if which == 1 then return X
else if which == 2 then do { x <- allTerms; y <- allTerms; return (Add x y) }
else if which == 3 then do { x <- allTerms; y <- allTerms; return (Mul x y) }
else if which == 4 then do { x <- allTerms; y <- allTerms; return (Div x y) }
else if which == 5 then do { x <- allTerms; y <- allTerms; return (Sub x y) }
else if which == 6 then do { x <- allTerms; y <- allTerms; return (Pow x y) }
else if which == 7 then do { x <- allTerms; y <- allTerms; return (Sqrt x) }
else if which == 8 then do { x <- allTerms; y <- allTerms; return (Tan x) }
else if which == 9 then do { x <- allTerms; y <- allTerms; return (Sin x) }
else if which == 10 then do { x <- allTerms; y <- allTerms; return (Cos x) }
else return (Num (which-10))
{- Then we create 20 input/output pairs of a random function -}
fun x = x+tan(x*x)
maps = let n=20 in zip [1..n] (map fun [1..n])
{- This tests a function in our language against a map of in/out pairs -}
check maps f = all test maps where
test (a,b) = (eval f a) == b
{- Naw lets see if a brute-force search can recover the original program
from the list of input/output pairs alone! -}
main = print $ take 1 $ filter (check maps) (runOmega allTerms)
{- Ouput: [Add X (Tan (Mul X X))]
Yay! As much as there are infinite possible solutions,
the first solution is actually our initial program.
-}
One possible definition goes like this:
f 0 = 0
f 1 = 2
f 2 = 1
f 3 = -1
f 4 = 0
f 5 = 0
f 6 = -76
f 7 = -3
f 8 = 3
f 9 = -1
f 10 = -1
f 11 = -6
f 12 = -1
f 13 = -1
f 14 = 4
f 15 = -2
f 16 = -10
f 17 = 0
f 18 = 0
f 19 = -1
f 20 = 2
f 21 = 3
f 22 = 0
f 23 = 4
f 24 = 2
f 25 = -1
f 26 = 0
f 27 = 0
f 28 = -4
f 29 = -2
f 30 = -14

ALU-n Procedure in Scheme

I'm a beginner to the Scheme language, so I'm having trouble writing a procedure to take in an n-bit number and put it into an ALU. The ALU is supposed to be constructed using 1-bit ALU's.
Here is the 1-bit ALU:
(define ALU1
(lambda (sel a b carry-in)
(multiplexor4 sel
(cons (andgate a b) 0)
(cons (orgate a b) 0)
(cons (xorgate a b) 0)
(multiplexor2 sub
(full-adder a b carry-in)
(full-adder a (notgate b) carry-in)))))
which, along with the multiplexors and full-adder, works.
Here is my attempt at using a couple of procedures to simulate the n-bit ALU:
(define ALU-helper
(lambda (selection x1 x2 carry-in n)
(if (= n 0)
'()
(ALU1 (selection x1 x2 carry-in)))))
(define ALUn
(lambda (selection x1 x2 n)
(ALU-helper (selection x1 x2 c n))))
And when it's done, it's supposed to take 2 n-bit numbers and add them, or subtract etc, according the to "selection." This would be the input:
(define x1 '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) )
(define x2 '(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) )
(ALUn 'add x1 x2 32)
And I get errors when running it that seem to be happening because of the "selection" parameter. I'm sure I'm just getting confused by all the parameters, but I'm not sure how to fix the problem and get the ALU to work. I'm running this using the Dr. Racket program, language R5RS.
By putting parentheses around your arguments to ALU1 inside ALU-helper, you are asking selection to be treated as a function, and only passing 1 argument to ALU-helper. Try:
(ALU1 selection x1 x2 carry-in))))
Same thing for the call to ALU-helper in ALUn.

Resources