Skip to content

Set operations #27

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
patham9 wants to merge 2 commits into
base: main
Choose a base branch
from
Open

Set operations #27

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
55d0c2d
Update: first implementation of set operations union, intersection, u…
patham9 Dec 18, 2024
d9a60e5
Update: mettamorph.scm subtraction is now supported too
patham9 Dec 18, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 39 additions & 1 deletion mettamorph.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -167,7 +167,7 @@
;we use this specialied macro instead of 'if'. Hereby, list/function call resolving is skipped for
;syntactic constructs as they represent neither a function call nor a list.
(define-syntax metta-macro-if
(syntax-rules (collapse superpose hyperpose Let Let* Match Case If == sequential quote do trace! and or)
(syntax-rules (collapse superpose hyperpose Let Let* Match Case If == sequential quote do trace! and or unique subtraction)
((_ collapse then else) then)
((_ superpose then else) then)
((_ hyperpose then else) then)
Expand All @@ -183,6 +183,8 @@
((_ trace! then else) then)
((_ and then else) then)
((_ or then else) then)
((_ unique then else) then)
((_ subtraction then else) then)
((_ arg then else) else)))

;Recursively, returns a list if arg is a list or executes a function if arg is a function
Expand Down Expand Up @@ -381,3 +383,39 @@
(syntax-rules ()
((_ (fname args ...) body)
(set! fname (memoized (lambda (args ...) body))))))

;; SET OPERATIONS
;""""""""""""""""

;Check recursively if the first element is in the rest of the list, omit it if it is
(define (unique-helper A)
(If (== A '())
'()
(If (and (pair? A) (member (car A) (cdr A)))
(unique-helper (cdr A))
(cons (car A) (unique-helper (cdr A))))))

;Syntax construct for unique (room for optimization: use hashmap)
(define-syntax unique
(syntax-rules ()
((_ args)
(amb1 (unique-helper (amb-collect (auto-list1 args)))))))

;Subtraction
(define (subtraction-helper A B)
(filter (lambda (x) (not (member x B))) A))

(define-syntax subtraction
(syntax-rules ()
((_ arg1 arg2)
(amb1 (subtraction-helper (amb-collect (auto-list1 arg1)) (amb-collect (auto-list1 arg2)))))))

;Intersection definition (room for optimization: use hashmap)
(= (intersection $A $B)
(Let* (($x (collapse $A))
($y (collapse $B)))
(If (== $x $y) (superpose $x))))

;Union definition
(= (union $A $B)
(superpose ($A $B)))