Using a defstruct database with remove-if-not - elisp

I'm trying to adapt this defstruct example by adding the select- functions described in the book: Practical Common Lisp. I'm running the code in Emacs using the Common Lisp package. The select-by-first does not return anything. In the Lisp book, the author does not use defstruct so I must need to do something slightly different?
(defun select-by-first (first-name)
(remove-if-not
#'(lambda (employee)
(equal (getf employee :first-name) first-name))
*emp-db*))
(select-by-first "steve")
The complete program:
(require 'cl)
;; http://mypage.iu.edu/~colallen/lp/node56.html
;; http://www.gigamonkeys.com/book/practical-a-simple-database.html
;;
(defvar *emp-db* nil)
(defun add-record (emp) (push emp *emp-db*))
(defstruct employee
age
first-name
last-name
sex
children)
(add-record (make-employee))
(add-record (make-employee
:age 34
:last-name 'farquharson
:first-name 'alice
:sex 'female))
(add-record (make-employee
:age 43
:last-name 'jobs
:first-name 'steve
:sex 'male))
(add-record (make-employee
:age 53
:last-name 'ballmer
:first-name 'steve
:sex 'male))
(defun select-by-first (first-name)
(remove-if-not
#'(lambda (employee)
(equal (getf employee :first-name) first-name))
*emp-db*))
(select-by-first "steve")

There are a few basic mistakes/problems. But with only two small changes we can get your example to work in Common Lisp.
Emacs Lisp's compatibility package for Common Lisp is not really a Common Lisp. It is generally preferable to use a real Common Lisp implementation. Emacs Lisp lacks a few basic things that are hard to emulate to make it compatible with Common Lisp - for example lexical closures (update 2014, the latest version of GNU Emacs now also supports lexical closures).
Minor change: I changed your example so that the database does not contain Steve Jobs twice, but Steve Jobs and Steve Ballmer.
Now, what would we need to change to make it work in Common Lisp?
(getf employee :first-name) should really be (employee-first-name employee) . The DEFSTRUCT macro generates these accessor functions automatically. In Common Lisp you can't use GETF to access the fields of real structures.
Your database has two objects with the name STEVE (a symbol), but you are searching for the name "steve" (a string). (equal 'steve "steve") is false. In general a symbol is not EQUAL to a string. So you should search with (select-by-first 'steve).
In LispWorks then:
CL-USER 11 > (select-by-first "steve")
NIL
CL-USER 12 > (select-by-first 'steve)
(#S(EMPLOYEE :AGE 53 :FIRST-NAME STEVE :LAST-NAME BALLMER :SEX MALE
:CHILDREN NIL)
#S(EMPLOYEE :AGE 43 :FIRST-NAME STEVE :LAST-NAME JOBS :SEX MALE
:CHILDREN NIL))

Thanks Rainer. Here's the finished code that runs in Emacs.
#!/usr/bin/emacs --script
;; Derived from code on these sites:
;;
;; http://mypage.iu.edu/~colallen/lp/node56.html
;; http://www.gigamonkeys.com/book/practical-a-simple-database.html
;;
(require 'cl)
(defvar *emp-db* nil)
(defun add-record (emp) (push emp *emp-db*))
(defstruct employee age first-name last-name sex children)
(add-record (make-employee))
(add-record (make-employee :age 34
:last-name 'farquharson
:first-name 'alice
:sex 'female))
(add-record (make-employee :age 43
:last-name 'jobs
:first-name 'steve
:sex 'male))
(add-record (make-employee :age 53
:last-name 'ballmer
:first-name 'steve
:sex 'male))
(defun select-by-first (first-name)
(remove-if-not
#'(lambda (employee)
(equal (employee-first-name employee) first-name))
*emp-db*))
(defun select-by-last (last-name)
(remove-if-not
#'(lambda (employee)
(equal (employee-last-name employee) last-name))
*emp-db*))
(princ "Employees with the first name Steve:\n")
(princ " ")
(princ (select-by-first 'steve))
(princ "\n")
(princ "Employees with the last name Jobs:\n")
(princ " ")
(princ (select-by-last 'jobs))
(princ "\n")

Related

first: expects a non-empty list

I keep getting the error first: expects a non-empty list given: (make-subject (make-person 22 'm 'MW17K) (list 220 301 189 272 311)) when starting my program and just can't find out why.
;;equals 25 but my code keeps erroring. please help
(person-age (subject-person (first sub)))
(define-struct person (age sex code))
(define-struct subject (person times))
(define VP01 (make-subject (make-person 22 'm 'MW17K) (list 220 301 189 272 311)))
(define VP02 (make-subject (make-person 25 'f 'MP25G) (list 234 197 253 257 206)))
(define VP03 (make-subject (make-person 23 'f 'CT03R) (list 197 202 214 222 233)))
(define VP04 (make-subject (make-person 20 'm 'MM09R) (list 273 314 257 264 217)))
(define VP05 (make-subject (make-person 19 'm 'KR22I) (list 198 197 228 253 199)))
(define VP06 (make-subject (make-person 26 'm 'FR01B) (list 212 204 289 294 223)))
(define VP07 (make-subject (make-person 28 'f 'RA15R) (list 258 323 189 247 303)))
(define VP08 (make-subject (make-person 22 'm 'RP18R) (list 221 307 182 271 316)))
(define VP09 (make-subject (make-person 24 'f 'GH31W) (list 230 295 304 264 237)))
(define VP10 (make-subject (make-person 19 'f 'OM29Q) (list 299 194 242 303 243)))
(define subjects (list VP01 VP02 VP03 VP04 VP05 VP06 VP07 VP08 VP09 VP10))
(define (idk sub)
(cond
[(empty? sub) empty]
[(< (person-age (subject-person (first sub)))
(person-age (subject-person (first (rest sub)))))
(idk (first sub))]
[else (idk (first (rest sub)))]))
(idk subjects)
You have a type mismatch:
(define (idk sub)
(cond
[(empty? sub) empty]
[(< (person-age (subject-person (first sub))) ; here2 -------- NB
(person-age (subject-person (first (rest sub)))))
(idk (first sub))] ; here1 ------------------------ NB
[else (idk (first (rest sub)))])) ; here3
(idk subjects)
idk is called with a list of subjects, so sub inside its definition is a list of subjects. This means that (first sub) at here1 is a subject.
But then you call idk with it at here1 (or here3), and it then calls (first sub) at here2. At this point sub is a subject, not a list. Hence the error,
first: expects a non-empty list
given: (make-subject (make-person 22 'm 'MW17K) (list 220 301 189 272 311))
I think use let and car,cdr make code more clear:
(let loop ([loop_list subjects])
(if (>= (length loop_list) 2)
(if (>= (person-age (subject-person (car loop_list)))
(person-age (subject-person (cadr loop_list))))
(person-age (subject-person (car loop_list)))
(loop (cdr loop_list)))
empty))

scheme adds 5 to all of the Grades in a given list and updates the letter

I'm trying to design a function that adds 5 to all of the grades in a given list and updates its letter grade.
Here's the data definition for grade,
;; A Grade is: (make-grade Symbol Number)
(define-struct grade (letter num))
The Symbol in a Grade represents:
'A >= 90,'B >= 80,'C >= 70,'D >= 60,'F < 60
test list,
(define grades
(list (make-grade 'D 62) (make-grade 'C 79) (make-grade 'A 93) (make-grade 'B 84)
(make-grade 'F 57) (make-grade 'F 38) (make-grade 'A 90) (make-grade 'A 95)
(make-grade 'C 76) (make-grade 'A 90) (make-grade 'F 55) (make-grade 'C 74)
(make-grade 'A 92) (make-grade 'B 86) (make-grade 'F 43) (make-grade 'C 73)))
I'm wondering how to updates the grade letter base on its current state to the List of Grades, do we use build-list and then cond the conditions? or something else?
For just adding 5 to all of the grades, i can simply use map function,
;; add5: Lof[Grade] -> Lof[grade-num]
;; adds 5 to all of the Grades in a given list
(define (add5 log)
(map
(lambda (a-grade)
(+ (grade-num a-grade) 5))
log))
Thanks in advance.
You can use map for this, simply create a new grade with the updated values. Just be careful if the current grade number plus 5 is greater than 100, in my code I added the restriction that no grade can be greater than 100. Assuming that you have implemented a procedure that converts grade numbers into letters (let's call it number->letter), this is one possible solution:
(define (add5 log)
(map (lambda (grade)
(let ((new-grade (+ (grade-num grade) 5)))
(if (<= new-grade 100)
(make-grade (number->letter new-grade) new-grade)
(make-grade 'A 100))))
log))

Clojure , increment a counter

I have a collection looking like this:
[({:customer_id "111", :product_id "222"})({:customer_id "333", :product_id "444"}{:customer_id "555", :product_id "666"})...]
And i would like to flag the "position" of the hash in the collection. At the end i would like my hash to look like this:
[({:product_id "222", :number "1"})({:product_id "444", :number "1"}{:product_id "666", :number "2"})...]
I'have try like this:
(->> (pig/load-clj "resources/test0_file")
(pig/map
(fn [ord]
(for [{:keys [product_id]} ord]
(let [nb (swap! (atom 0) inc)]
{:product_id product_id :number nb}))))
But in that case nb is not incrementing. Thanks for you help
map-indexed , assoc and dissoc provide a cleaner solution
(def products ['({:customer_id "111", :product_id "222"})
'({:customer_id "333", :product_id "444"}
{:customer_id "555", :product_id "666"})])
(for [p products]
(map-indexed #(dissoc (assoc %2 :number (str (inc %))) :customer_id ) p))
;user=>(({:number 1, :product_id "222"}) ({:number 1, :product_id "444"} {:number 2, :product_id "666"}))
Resisting the urge to play too much code golf, here's a working implementation:
(def products ['({:customer_id "111", :product_id "222"})
'({:customer_id "333", :product_id "444"}
{:customer_id "555", :product_id "666"})])
(defn number-in-list [products]
(loop [products products counter 1 result []]
(if (empty? products)
(seq result)
(let [[{:keys [product_id]} & ps] products
updated {:product_id product_id :number (str counter)}]
(recur ps (inc counter) (conj result updated))))))
(vec (map number-in-list products))
Here's another:
(vec
(for [product-list products
:let [numbers (iterate inc 1)
pairs (partition 2 (interleave numbers product-list))]]
(for [[number {:keys [product_id]}] pairs]
{:product_id product_id :number (str number)})))
There is some destructuring going on, but it looks like you have that covered.
I assume that the output is what you really want and for some reason care to have a vector of lists and :number as string. If that is not the case you can drop the calls to seq, str and vec.
Note that this implementation is pure and does not use any mutable contructs.
In general, atoms are pretty rare and only used for some kind of (semi) global, mutable state. For such problems as yours it's more idiomatic to use loops, ranges, sequences etc.
To break this down, this returns an infinite sequence of natural numbers:
(iterate inc 1)
; think '(1 (inc 1) (inc (inc 1)) ..)
This bit returns a sequence of numbers and products interleaved (until one of them runs out):
(interleave numbers product-list)
; [first_number first_product second_number second_product ..]
Then we partition it to pairs:
(partition 2 ...)
; [[first_number first_product] [second_number second_product] ...]
... and finally for each of these pairs we construct the record that we wanted.
Given
(def data [[{:customer_id "111", :product_id "222"}]
[{:customer_id "333", :product_id "444"}
{:customer_id "555", :product_id "666"}]])
then
(map
#(map-indexed
(fn [n m]
(assoc
(select-keys m [:product_id])
:number
(str (inc n))))
%)
data)
is
(({:number "1", :product_id "222"})
({:number "1", :product_id "444"}
{:number "2", :product_id "666"}))

make-operator returns swindleobject

#lang swindle
(require swindle/misc
swindle/setf
)
(defclass* jacket ()
(size :initvalue 40 :accessor sj)
:printer #t)
(defclass* trousers ()
(size :initvalue 44 :accessor st)
:printer #t)
(defclass* suit (jacket trousers)
If i compile this code and write (make suit) | (make jacket) | make (trousers) into the interpreter, the return is always #<procedure:swindleobj> but it should be sth like #<jacket size=40>.
Did I miss any requires or what am I doing wrong?
Your code is working for me:
#lang swindle
(defclass* jacket () (size :initvalue 40 :accessor sj) :printer #t)
(define x (make jacket))
(displayln x)
=> #<jacket: size=40>
(displayln (slot-ref x 'size))
=> 40
(displayln (sj x))
=> 40

structure definitions in scheme

(define-struct student (first last major age))
(define student1 (make-student "David" "Smith" 'Math 19))
(define student2 (make-student"Joe" "Jones" 'Math 21))
(define student3 (make-student "Eli" "Black" 'Spanish 20))
(define (same-age? s1 s2)
(string=? (student-age s1)
(student-age s2)))
so I am trying to get a boolean as an output if two students are the same age, but when I run it, it says it expects a string as the 1st argument, but given 19. What is the problem?
A couple of your questions are related, you seem to be struggling with comparisons for different data types, here are some pointers:
When comparing numbers, use =
When comparing characters, use char=?
When comparing symbols, use symbol=?
When comparing strings, use string=?
Or simply use equal?, the catch-all procedure that will work for several types and will return true as long as both of its operands are of the same type and equal
For example, all of the following comparisons will return #t:
(equal? 1 1)
(equal? 1.5 1.5)
(equal? #\a #\a)
(equal? 'x 'x)
(equal? "a" "a")
(equal? (list 1 2 3) (list 1 2 3))
You create students with their age fields being integers, not strings (note the lack of double-quotation marks), then try to use string=? function to compare them. You should either use the = function to compare on age:
(define-struct student (first last major age))
(define student1 (make-student "David" "Smith" 'Math 19))
(define student2 (make-student "Joe" "Jones" 'Math 21))
(define student3 (make-student "Eli" "Black" 'Spanish 20))
(define (same-age? s1 s2)
(= (student-age s1)
(student-age s2)))
or create students with their age fields represented as strings:
(define-struct student (first last major age))
(define student1 (make-student "David" "Smith" 'Math "19"))
(define student2 (make-student "Joe" "Jones" 'Math "21"))
(define student3 (make-student "Eli" "Black" 'Spanish "20"))
(define (same-age? s1 s2)
(string=? (student-age s1)
(student-age s2)))

Resources