Compare triangles in Prolog - prolog

I'm trying to compare two triangles by two point and height.
compare_tri( triangle ( point(X1,Y1), point(X2,Y2), H1),
triangle( point(X3,Y3), point(X4,Y4), H2)) :-
A1 is ((X2-X1)*(X2-X1)),
B1 is ((Y2-Y1)*(Y2-Y1)),
C1 is (A1+B1),
D1 is (sqrt(C1)),
S1 is (D1*H1),
A2 is ((X4-X3)*(X4-X3)),
B2 is ((Y4-Y3)*(Y4-Y3)),
C2 is (A2+B2),
D2 is (sqrt(C2)),
S2 is (D2*H2),
( (S1 < S2)
-> (S1 is 2), (S2 is 1)
; (S2 is 2), (S1 is 1)
),
write(S1), write('bigger than '), write(S2).
but I get the error message 'syntax operator : operator expected'
What's the problem?

There must be no space between triangle and next brace: change triangle ( point(X1,Y1) to triangle( point(X1,Y1) and the error will be gone.

apart the syntax error, already addressed by Sergey, a general advice: attempt to write reusable code in first place. It's easier to debug, to read, to remember....
triangle_area(triangle(point(X1,Y1), point(X2,Y2), H), S1) :-
A1 is ((X2-X1)*(X2-X1)),
B1 is ((Y2-Y1)*(Y2-Y1)),
C1 is (A1+B1),
D1 is (sqrt(C1)),
S1 is (D1*H1).
compare_tri(T1,T2) :-
triangle_area(T1,S1),
triangle_area(T2,S2), etc etc...

Related

Modular run-length encoding

Question
How to implement a run length encoding modulus n>=1? For n=4, considering the inputAAABBBBABCCCCBBBDAAA, we want an output of [('D', 1), ('A', 3)]. Note the long-distance merging due to the modulus operation. See Explanation.
Explanation
The first occurance of BBBB encodes to (B, 4) whose modulus 4 is (B, 0), thus canceling itself out. See the diagram (ignore spaces; they are simply for illustrative purposes):
AAABBBBABCCCCBBBDAAA
A3 B4 ABCCCCBBBDAAA
A3 B0 ABCCCCBBBDAAA
A3 ABCCCCBBBDAAA
A4 BCCCCBBBDAAA
A0 BCCCCBBBDAAA
BCCCCBBBDAAA
...
DA3
A simpler example when no merging happens since none gets canceled by modulus 4: input AAABABBBC produces output [('A',3),('B',1),('A',1),('B',3),('C',1)].
Requirements
Haskell implementations are preferred but others are welcome too!
Prefer standard/common library functions over 3rd party libraries.
Prefer readable and succint programs utilizing higher-order functions.
Prefer efficiency (do not loop over the whole list whenever unnecessary)
My program
I implemented this in Haskell, but it looks too verbose and awful to read. The key idea is to check three tuples at a time, and only advance one tuple forward if we can neither cancel out 0 tuples nor merge a pair of tuples among the three tuples at hand.
import Data.List (group)
test = [('A', 1), ('A', 2), ('B', 2), ('B', 2), ('A', 1), ('B', 1), ('C', 1), ('C', 3), ('B', 3), ('D', 1), ('A', 3)] :: [(Char, Int)]
expected = [('D', 1), ('A', 3)] :: [(Char, Int)]
reduce' :: [(Char, Int)] -> [(Char, Int)]
reduce' [ ] = [] -- exit
reduce' ( (_,0):xs) = reduce' xs
reduce' (x1:(_,0):xs) = reduce' (x1:xs)
reduce' ( (x,n):[]) = (x,n):[] -- exit
reduce' ( (x1,n1):(x2,n2):[]) -- [previous,current,NONE]
| x1 == x2 = reduce' ((x1, d4 (n1+n2)):[])
| otherwise = (x1,n1):( -- advance
reduce' ((x2, d4 n2 ):[]))
reduce' ((x1,n1):(x2,n2):(x3,n3):xs) -- [previous,current,next]
| n3 == 0 = reduce' ((x1, d4 n1 ):(x2, d4 n2 ):xs)
| n2 == 0 = reduce' ((x1, d4 n1 ):(x3, d4 n3 ):xs)
| x2 == x3 = reduce' ((x1, d4 n1 ):(x2, d4 (n2+n3)):xs)
| x1 == x2 = reduce' ((x2, d4 (n1+n2)):(x3, d4 n3 ):xs)
| otherwise = (x1,n1):( -- advance
reduce' ((x2, d4 n2 ):(x3, d4 n3 ):xs)
)
-- Helpers
flatten :: [(Char, Int)] -> String
flatten nested = concat $ (\(x, n) -> replicate n x) <$> nested
nest :: String -> [(Char, Int)]
nest flat = zip (head <$> xg) (d4 .length <$> xg)
where xg = group flat
reduce = reduce' . nest
d4 = (`rem` 4)
Thoughts
My inputs are like the test variable in the snipped above. We could keep doing flatten then nest until its result doesn't change, and would definitely look simpler. But it feels it is scanning the whole list many times, while my 3-pointer implementation scans the whole list only once. Maybe we can pop an element from left and add it to a new stack while merging identical consecutive items? Or maybe use Applicative Functors? E.g. this works but not sure about its efficiency/performance: reduce = (until =<< ((==) =<<)) (nest . flatten).
Algorithm
I think you are making this problem much harder by thinking of it in terms of character strings at all. Instead, do a preliminary pass that just does the boring RLE part. This way, a second pass is comparatively easy, because you can work in "tokens" that represent a run of a certain length, instead of having to work one character at a time.
The only data structure we need to maintain as we do the second pass through the list is a stack, and we only ever need to look at its top element. We compare each token that we're examining with the top of the stack. If they're the same, we blend them into a single token representing their concatenation; otherwise, we simply push the next token onto the stack. In either case, we reduce token sizes mod N and drop tokens with size 0.
Performance
This algorithm runs in linear time: it processes each input token exactly once, and does a constant amount of work for each token.
It cannot produce output lazily. There is no prefix of the input that is sufficient to confidently produce a prefix of the output, so we have to wait till we have consumed the entire input to produce any output. Even something that "looks bad" like ABCABCABCABCABC can eventually be cancelled out if the rest of the string is CCCBBBAAA....
The reverse at the end is a bummer, but amortized over all the tokens it is quite cheap, and in any case does not worsen our linear-time guarantee. It likewise does not change our space requirements, since we already require O(N) space to buffer the output (since as the previous note says, it's never possible to emit a partial result).
Correctness
Writing down my remark about laziness made me think of your reduce solution, which appears to produce output lazily, which I thought was impossible. The explanation, it turns out, is that your implementation is not just inelegant, as you say, but also incorrect. It produces output too soon, missing chances to cancel with later elements. The simplest test case I can find that you fail is reduce "ABABBBBAAABBBAAA" == [('A',1),('A',3)]. We can confirm that this is due to yielding results too early, by noting that take 1 $ reduce ("ABAB" ++ undefined) yields [(1, 'A')] even though elements might come later that cancel with that first A.
Minutiae
Finally note that I use a custom data type Run just to give a name to the concept; of course you can convert this to a tuple cheaply, or rewrite the function to use tuples internally if you prefer.
Implementation
import Data.List (group)
data Run a = Run Int a deriving Show
modularRLE :: Eq a => Int -> [a] -> [Run a]
modularRLE groupSize = go [] . tokenize
where go stack [] = reverse stack
go stack (Run n x : remainder) = case stack of
[] -> go (blend n []) remainder
(Run m y : prev) | x == y -> go (blend (n + m) prev) remainder
| otherwise -> go (blend n stack) remainder
where blend i s = case i `mod` groupSize of
0 -> s
j -> Run j x : s
tokenize xs = [Run (length run) x | run#(x:_) <- group xs]
λ> modularRLE 4 "AAABBBBABCCCCBBBDAAA"
[Run 1 'D',Run 3 'A']
λ> modularRLE 4 "ABABBBBAAABBBAAA"
[]
My first observation will be that you only need to code one step of the resolution, since you can pass that step to a function that will feed it its own output until it stabilizes. This function was discussed in this SO question and was given a clever answer by #galva:
--from https://stackoverflow.com/a/23924238/7096763
converge :: Eq a => (a -> a) -> a -> a
converge = until =<< ((==) =<<)
This is the entrypoint of the algorithm:
-- |-------------step----------------------| |---------------process------|
solve = converge (filter (not . isFullTuple) . collapseOne) . fmap (liftA2 (,) head length) . group
Starting from the end of the line and moving backwards (following the order of execution), we first process a String into a [(Char, Int)] using fmap (liftA2 (,) head length) . group. Then we get to a bracketed block that contains our step function. The collapseOne takes a list of tuples and collapses at most one pair of tuples, deleting the resulting tuple if necessary (if mod 4 == 0) ([('A', 1), ('A', 2), ('B', 2)] ==> [('A', 3), ('B', 2)]):
collapseOne [x] = [x]
collapseOne [] = []
collapseOne (l:r:xs)
| fst l == fst r = (fst l, (snd l + snd r) `mod` 4):xs
| otherwise = l:(collapseOne (r:xs))
You also need to know if tuples are "ripe" and need to be filtered out:
isFullTuple = (==0) . (`mod` 4) . snd
I would argue that these 8 lines of code are significantly easier to read.

How to access rule data in PROLOG

I have to determine whether two rectangles overlap or not, I can do this but I am struggling with figuring out how to grab my given data, and compare it to eachother to determine larger values.
%This is :what would be happening :
%separate(rectangle(0,10,10,0), rectangle(4,6,6,4))
separate(R1,R2) :-
%I Have to figure out how to take the values from R1 and R2 and compare
%them to one another.
.
It is called "pattern matching".
separated(R1, R2) :-
R1 = rectangle(A1, B1, C1, D1),
R2 = rectangle(A2, B2, C2, D2),
/* now just use your As and Bs */
and in many cases it is better to write straight away:
separated(rectangle(A1, B1, C1, D1), rectangle(A2, B2, C2, D2)) :-
/* now just use your As and Bs */

Show that cross product of a x b is perpendicular to b [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
This question does not appear to be about programming within the scope defined in the help center.
Closed 4 years ago.
Improve this question
How do I know the cross product of A x B is perpendicular to B.
I'm little confused because there are 3 vectors instead of 2.
A = (0, -2, 5)
B = (2, 2, -5)
C= ( 7, -4, -5)
On R2 plane, (a x b) * b = 0 proves that a x b is perpendicular to b , but how do I find that on R3.
SO, after some of Research I finally figured out how to prove the vectors are perpendicularly to each other on R3.
A= (a1, a2, a3)
B= (b1, b2, b3)
C= (c1, c2, c3)
(AB x AC )* AB = 0
(AB x AC )* AC = 0
I don't think you understand what the cross product does. It gives a vector orthogonal to the two vectors.
The cross product a × b is defined as a vector c that is perpendicular
(orthogonal) to both a and b, with a direction given by the right-hand
rule and a magnitude equal to the area of the parallelogram that the
vectors span.
you can simply show this by using the definition of orthogonality which is from their dot products being zero.
Questions like this come down to precisely what you take to be your definitions.
For instance, one way to define the cross-product A x B is this:
By R^3 we mean three dimensional real space with a fixed orientation.
Observe that two linearly independent vectors A and B in R^3 span a plane, so every vector perpendicular to them lies on the (unique) line through the origin perpendicular to this plane.
Observe that for any positive magnitude, there are precisely two vectors along this line with that magnitude.
Observe that if we consider the ordered basis {A, B, C} of R^3, where C is one of the two vectors from the previous step, then one choice matches the orientation of R^3 and the other does not.
Define A x B as the vector C from the previous step for which {A, B, C} matches the orientation of R^3.
For instance, this is how the cross product is defined in the Wikipedia article:
"The cross product a × b is defined as a vector c that is perpendicular (orthogonal) to both a and b, with a direction given by the right-hand rule and a magnitude equal to the area of the parallelogram that the vectors span."
If this is your definition, then there is literally nothing to prove, because the definition already has the word "perpendicular" in it.
Another definition might go like this:
By R^3 we mean three-dimensional real space with a fixed orientation.
For an ordered basis { e1, e2, e3 } of R^3 with the same orientation as R^3, we can write any two vectors A and B as A = a1 e1 + a2 e2 + a3 e3 and B as B = b1 e1 + b2 e2 + b3 e3.
Observe that, regardless of the choice of { e1, e2, e3 } we make in step 2, the vector C := (a2 b3 - b2 a3) e1 - (a1 b3 - b3 a1) e2 + (a1 b2 - b1 a2) e3 is always the same.
Take the vector C from the previous step as the definition of A x B.
This isn't a great definition, because step 3 is both a lot of work and complete black magic, but it's one you'll commonly see. If this is your definition, the best way to prove that A x B is perpendicular to A and B would be to show that the other definition gives you the same vector as this one, and then the perpendicularity comes for free.
A more direct way would be to show that vectors with a dot product of zero are perpendicular, and then to calculate the dot product by doing a bunch of algebra. This is, again, a fairly popular way to do it, but it's essentially worthless because it doesn't offer any insight into what's going on.

Prolog - Checking 2x2 cells in a list of lists

Basically I am trying to implement a program in prolog that can solve a game called Yin Yang, independente of the size of the board.
The game is basically to paint every cell of the board of a specific color (either black or white) and all cells of same color are connected to each other, vertically or horizontally. I am representing this with a list of lists. Example initial->solution: https://i.gyazo.com/24a70d868934dfbf1540343e89d14c4b.png
However there is a rule I'm having trouble with: "No 2X2 group of cells can contain circles of a single color."
Any ideas how I can assure this doesn't happen using the clpfd library?
List representing board example:
[[0,0,0,0,0,0],
[0,0,0,1,0,0],
[0,0,1,1,2,0],
[0,2,0,0,2,2],
[1,0,2,0,1,0],
[0,1,0,0,0,1]]
I managed to do a variant of the problem :
get-elem(B, R, C, E) :- get-line(B, R, Row), get-line(Row, C, E).
get-line([R|_], 0, R).
get-line([_|A], N, R) :- get-line(A, M, R), N is M + 1.
twoXTwo(B, R, C) :- \+ (R1 is R+ 1, C1 is C+1,
get-elem(B, R, C, E1),
get-elem(B, R1, C, E2), E1 = E2,
get-elem(B, R, C1, E3), E2 = E3,
get-elem(B, R1, C1, E4), E3 = E4).
where I check the element at positions [(r+1,c), (r,c+1), (r+1,c+1)] are not the same element. I am also not sure what the numbers mean given you have either black (1) or white (0).
I solved the issue: This is the code I used for solving the problem described above.
twoByTwo([_],[_]).
twoByTwo([F1,S1|T1],[F2,S2|T2]):-
F1 + S1 + F2 + S2 #> 4,
F1 + S1 + F2 + S2 #< 8,
twoByTwo([S1|T1],[S2|T2]).
Basically twoByTwo receives a line of the board (in order) on each argument.
So basically this function is called recursively: twoByTwo(Line1,Line2), twoByTwo(Line2,Line3), etc.

Checking a square of numbers in Prolog

square([A1, A2, A3|_], [B1, B2, B3|_], [C1, C2, C3|_]):-
all_diff([A1, A2, A3, B1, B2, B3, C1, C2, C3]).
squares([[]|_]):- !.
squares([[A1,A2,A3|A4], [B1,B2,B3|B4], [C1,C2,C3|C4], [D1,D2,D3|D4], [E1,E2,E3|E4], [F1,F2,F3|F4], [G1,G2,G3|G4], [H1,H2,H3|H4], [I1,I2,I3|I4]]):-
square([[A1,A2,A3], [B1,B2,B3], [C1,C2,C3]]),
square([[D1,D2,D3], [E1,E2,E3], [F1,F2,F3]]),
square([[G1,G2,G3], [H1,H2,H3], [I1,I2,I3]]),
squares([A4, B4, C4, D4, E4, F4, G4, H4, I4]).
I'm getting a uncaught exception: error(existence_error(procedure,square/1),squares/1) - I'm new to Prolog so I'm not quite sure what this is saying (well, where it's saying it's going wrong).
This is inside a sudoku program, by the way.
squares iterates through the 3x3 squares of the sudoku puzzle starting with the top left, middle left, and bottom left - moving to the top middle, middle middle, bottom middle, and so on.
square checks the focus square - A1, A2, A3 are the first three values of the first row
B1, B2, B3 are the first three values of the second row, and so on. It assembles them into one array and checks to make sure they are all different.
on the lines
square([[A1,A2,A3], [B1,B2,B3], [C1,C2,C3]]),
square([[D1,D2,D3], [E1,E2,E3], [F1,F2,F3]]),
square([[G1,G2,G3], [H1,H2,H3], [I1,I2,I3]]),
you'll note that the type is ([[],[],[]]), however, the function, square is ([],[],[]).
Changing the lines to
square([A1,A2,A3], [B1,B2,B3], [C1,C2,C3]),
square([D1,D2,D3], [E1,E2,E3], [F1,F2,F3]),
square([G1,G2,G3], [H1,H2,H3], [I1,I2,I3]),
fixes the problem.

Resources