I spent 3 hours trying to figure out to modify a string at point to different cases, e.g. isFailedUpgrade to IS_FAILED_UPGRADE.
I got to the point where i can get the string at point to a var text but has no idea how to update a string text to the desired case.
(defun change-case ()
(interactive)
(let* ((bounds (if (use-region-p)
(cons (region-beginning) (region-end))
(bounds-of-thing-at-point 'symbol)))
(text (buffer-substring-no-properties (car bounds) (cdr bounds))))
(when bounds
(delete-region (car bounds) (cdr bounds))
(insert (change-case-helper text)))))
# the following code is rubbish
(defun change-case-helper (text)
(let ((output ""))
(dotimes (i (length text))
(concat output (char-to-string (aref text i))))
output))
Since i am on the journey to learn a little emacs function myself, i prefer to write this function myself instead of use an existing magical function.
ok after another 2 hours, i think i've figured it out:
(defun change-case ()
(interactive)
(let* ((bounds (if (use-region-p)
(cons (region-beginning) (region-end))
(bounds-of-thing-at-point 'symbol)))
(text (buffer-substring-no-properties (car bounds) (cdr bounds))))
(when bounds
(delete-region (car bounds) (cdr bounds))
(insert (change-case-helper text)))))
(defun change-case-helper (text)
(when (and text (> (length text) 0))
(let ((first-char (string-to-char (substring text 0 1)))
(rest-str (substring text 1)))
(concat (if (upcasep first-char) (string ?_ first-char) (string (upcase first-char)))
(change-case-helper rest-str))))
)
(defun upcasep (c) (and (= ?w (char-syntax c)) (= c (upcase c))))
still feel this is pretty awkward, please comment let me know if there is a better way of writing this function.
Related
I've just started learning Racket.
I have written this procedure:
#lang racket
(define split
(lambda (list)
(define plus-list '())
(define minus-list '())
(cond ((null? list) '())
(else
(do ([i (length list) (- i 1)])
((zero? i))
(define l (list-ref list i))
(define item (last-element-on-list l))
(cond ((= (cdr l '+)) (set! plus-list (cons list plus-list)))
((= (cdr l '-)) (set! minus-list (cons list minus-list))))
)
(cons plus-list minus-list)
)
)
)
)
And instead of using (list-ref lst i) inside de do I have defined a variable l:
(define (list-ref lst i) l)
But it seems that I cann't do that, because I get the error:
define: not allowed in an expression context in: (define l (list-ref
lst i))
But there are a lot of define inside the do.
If I remove all the define inside the do, I have to write a lot of code and it is not easier to read and understand:
(define split
(lambda (list)
(define plus-list '())
(define minus-list '())
(cond ((null? list) '())
(else
(do ([i (length list) (- i 1)])
((zero? i))
(cond ((= (cdr (last-element-on-list (list-ref list i)) '+)) (set! plus-list (cons (list-ref list i) plus-list)))
((= (cdr (last-element-on-list (list-ref list i)) '-)) (set! minus-list (cons (list-ref list i) minus-list))))
)
(cons plus-list minus-list)
)
)
)
)
How can I define a variable inside a do?
Reading your other question I see why you write the bolded expressions -
…
(cond ((= (cdr (last-element-on-list (list-ref list i)) '+))
(set! plus-list
(cons (list-ref list i) plus-list)))
((= (cdr (last-element-on-list (list-ref list i)) '-))
(set! minus-list
(cons (list-ref list i) minus-list))))
…
Your input list shown there is –
(define lst
'((n 25 f +)
(s 25 m +)
(ll 20 no -)))
Your split is inspecting the contents of each element of l. split has overstepped its boundaries and now it only works for lists containing elements of this particular structure. Along with set!, lack of else in a cond is typically an indication you're doing something wrong. You also call (cdr (last-element-of-list ...)). If last-element-of-list returns an atom, cdr would throw an error here.
Consider designing split in a more generic way –
(define (split proc l)
(define (loop l true false)
(cond ((null? l)
(cons true false))
((proc (car l))
(loop (cdr l)
(cons (car l) true)
false))
(else
(loop (cdr l)
true
(cons (car l) false)))))
(loop l '() '()))
(split (lambda (x) (> x 5))
'(1 5 3 9 7 0 8 3 2 6 4))
;; '((6 8 7 9) 4 2 3 0 3 5 1)
If our list contains different elements, we can still use the same split procedure –
(split (lambda (x) (eq? '+ (cadr x)))
'((1 +) (1 -) (2 +) (3 +) (2 -) (3 -) (4 +)))
;; '(((4 +) (3 +) (2 +) (1 +)) (3 -) (2 -) (1 -))
I think it's never too early to start learning continuation passing style. Below, return represents our continuation and defaults to cons, the same procedure we used to return the final result in our original implementation. Intuitively, a continuation represents "the next step" of the computation –
(define (split proc l (return cons)) ;; `return` is our continuation
(if (null? l)
;; base case: list is empty, return empty result
(return '() '())
;; inductive case: at least one `x`
(let* ((x (car l))
(bool (proc x)))
(split proc ;; tail recur with our proc
(cdr l) ;; ... a smaller list
(lambda (t f) ;; ... and "the next step"
(if bool ;; if `(proc x)` returned true
(return (cons x t) ;; ... cons the `x` onto the `t` result
f) ;; ... and leave the `f` the same
(return t ;; otherwise leave `t` the same
(cons x f)))))))) ;; ... and cons the `x` onto the `f` result
If we run our split procedure, you'll notice we get the same exact output as above. At first glance it looks like we made a mess of a nice program, however there's one distinct advantage of this implementation. Because the continuation is user-configurable, instead of cons, we could decide an entirely different fate for our two lists, t and f –
(split (lambda (x) (eq? '+ (cadr x)))
'((1 +) (1 -) (2 +) (3 +) (2 -) (3 -) (4 +))
(lambda (plus minus)
(printf "plus: ~a, minus: ~a\n" plus minus)))
;; plus: ((1 +) (2 +) (3 +) (4 +)), minus: ((1 -) (2 -) (3 -))
Note how plus and minus were given the respective results. We didn't have to pick apart an intermediate cons result. More intuitively, we want printf to be "the next step", but we only need to specify the first argument –
(split (lambda (x) (eq? '+ (cadr x)))
'((1 +) (1 -) (2 +) (3 +) (2 -) (3 -) (4 +))
(curry printf "plus: ~a, minus: ~a\n"))
;; plus: ((1 +) (2 +) (3 +) (4 +)), minus: ((1 -) (2 -) (3 -))
Now we've scratched the surface of functional style :D
do loops are not idiomatic Racket. They are inherited from Scheme, and for whatever reason, they don’t permit internal definitions. I have never once used a do loop in Racket, since the for comprehensions are more functional, and they’re just generally easier to work with. Plus, since they originate in Racket, not in Scheme, they support internal definitions as you’d expect.
You could write your split function using for/fold instead of do, which has the added advantage of not needing to use set! (and avoiding the quadratic access time of using list-ref instead of iterating through the list). I’m not completely sure what your split function is supposed to do, as even with the internal definition removed, it does not compile, but here’s my best guess at what you might be attempting to do:
(define (split lst)
(for/fold ([plus-lst '()]
[minus-lst '()])
([l (in-list lst)])
(define item (last l))
(cond
[(equal? item '+)
(values (cons l plus-lst) minus-lst)]
[(equal? item '-)
(values plus-lst (cons l minus-lst))]
[else
(values plus-lst minus-lst)])))
Aside from the obvious restructuring to use for/fold instead of do, this code also makes the following changes over your code:
It uses the built-in last function from racket/list to get the last element of a list.
It uses equal? instead of = to compare symbols, since = is specifically for comparing numbers.
It indents things properly and puts close parentheses in idiomatic locations.
I fixed your code using let, read documentation about let it's heavily used in Scheme/Racket. I haven't used Scheme lately so I couldn't explain it as well as it is in documentation.
Shortly it's local symbol definition/redefinition, and you can use symbol with value only in let body.
Short example on let
(define x 5)
(let ((x 10))
(display x)) # => 10
(display x) # => 5
(let ((y 1))
(display y)) # => 1
(display y) # = => (error) y: undefined
Your code fixed using let
(define split
(lambda (list)
(let ((plus-list '())
(minus-list '()))
(cond ((null? list) '())
(else
(do ([i (length list) (- i 1)])
((zero? i))
(let ((l (list-ref list i))
(item (last-element-on-list l)))
(cond ((= (cdr l '+)) (set! plus-list (cons list plus-list)))
((= (cdr l '-)) (set! minus-list (cons list minus-list))))))
(cons plus-list minus-list))))))
Say that I have a text file which is formatted like this:
(:question
(hello
how
are
you))
(:answer
(i
am
fine
thanks))
which I wish to read and then convert into a hashtable where the first words (starting with a :) are the keys, and then the inner lists are the values for the given keys. How can I do this? I have tried several approaches to this problem, but I cannot find a good way to read the file and then convert it to a hashtable.
Since you posted an attempt, it might be worth comparing how it could be done a little bit more simply. The loop macro supports a bunch of different clauses, and some can be very handy here. If I knew that I could read values of the form (key value) from a stream until there were no more values (in this case, until either a nil is read, or the end of stream is encountered), I'd do something like this:
(defun read-hashtable (&optional (stream *standard-input*))
(loop
with table = (make-hash-table) ; the hash table
with sentinel = (cons 1 1) ; unique value for EOF
for x = (read stream nil sentinel nil) ; read value, sentinel if EOF
until (eq sentinel x) ; until EOF, indicated by sentinel
do (setf (gethash (first x) table) (second x)) ; set a value in the table
finally (return table))) ; finally return the table
Then you can use it like this:
(with-open-file (in ".../input.txt")
(read-hashtable in))
;=> #<HASH-TABLE :TEST EQL :COUNT 2 {10056B2C43}>
If you're averse to loop, it's easy to do this with do, as well:
(defun read-hashtable (&optional (stream *standard-input*))
(do* ((sentinel (cons 1 1))
(table (make-hash-table))
(x (read stream nil sentinel nil) (read stream nil sentinel nil)))
((eq x sentinel) table)
(setf (gethash (first x) table) (second x))))
I managed to solve the problem using the following code:
(defun symbols-to-lowercase-strings (sym-list)
(let ((newlist (list '())))
(loop for symbol in sym-list
do (progn
(setf symbol (string symbol))
(setf symbol (string-downcase symbol))
(push symbol newlist)))
(subseq newlist 0 (- (length newlist) 1))))
(defun read-file (filename)
(let ((classes (make-hash-table :test #'equal))
(class-lists NIL))
(with-open-file (stream filename :direction :input)
(loop
for line = (read stream nil)
while line
collect line
do (push (cons (car line) (cdr line)) class-lists))
(loop for line in class-lists
do (setf (gethash (car line) classes) (list (symbols-to-lowercase-strings (car (cdr line))) '(0)))))
classes))
I need to create a recursive method in LISP that takes the numbers in a list and finds the sum. Anything in the list that is not a number is skipped (For example, if the list contains "Cheese 12 Dog 8 Shoe 5", the output would be 25).
Right now my code finds the sum, but throws an error if there is anything in the list that is not a number. What can be changed to fix that?
(defun adder (lis)
(cond
((null lis) 0)
(t (eval (cons '+ lis)) )
)
)
This would do:
(defun adder (lis)
(if (null lis)
0
(let ((c (car lis)))
(if (numberp c)
(+ c (adder (cdr lis)))
(adder (cdr lis))))))
Your version is not recursive (you don't call adder inside of adder), maybe you meant something like this (which is non-recursive)?
(defun adder (lis)
(apply '+ (remove-if-not 'numberp lis)))
Using apply on lists that can be long is a bit dangerous. If the list is longer than call-arguments-limit, then (apply '+ list) won't work. Now, call-arguments-limit is typically pretty big in modern Lisps, but it's allowed to be as small as 50. For more information about this, see:
Common lisp: How many argument can a function take? (this answer uses (reduce '+ …))
In Lisp, how many inputs can the + function actually have?
I think your best bet would be to use reduce '+ list with a key function that takes each number to itself and each non-number to 0. (This key function is what abiessu mentioned in a comment.)
(reduce '+ list :key (lambda (x) (if (numberp x) x 0)))
CL-USER> (let ((list '(cheese 12 dog 8 shoe 5)))
(reduce '+ list :key (lambda (x) (if (numberp x) x 0))))
25
CL-USER> (let ((list '()))
(reduce '+ list :key (lambda (x) (if (numberp x) x 0))))
0
Instead of using a more complex key function, you could also use (remove-if-not 'numberp list) to get rid of the non-numbers (or (remove-if (complement 'numberp) list)):
CL-USER> (let ((list '(cheese 12 dog 8 shoe 5)))
(reduce '+ (remove-if-not 'numberp list)))
25
CL-USER> (let ((list '()))
(reduce '+ (remove-if-not 'numberp list)))
0
I previously asked a question concerning message passing Abstraction here: MIT Scheme Message Passing Abstraction
The question asked that I:
Write a mailman object factory (make-mailman) that takes in no parameters and returns
a message-passing object that responds to the following messages:
'add-to-route: return a procedure that takes in an arbitrary number of mailbox objects
and adds them to the mailman object's “route”
'collect-letters: return a procedure that takes in an arbitrary number of letter
objects and collects them for future distribution
'distribute: add each of the collected letters to the mailbox on the mailman's route
whose address matches the letter's destination and return a list of any letters whose
destinations did not match any mailboxes on the route (Note: After each passing of
'distribute the mailman object should have no collected letters.)
I had already written 2 procedures earlier as part of this assignment to make a mailbox and make a letter:
(define (make-letter destination message)
(define (dispatch x)
(cond ((eq? x 'get-destination) destination)
((eq? x 'get-message) message)
(else "Invalid option.")))
dispatch)
(define (make-mailbox address)
(let ((T '()))
(define (post letter)
(assoc letter T))
(define (previous-post post)
(if (null? (cdr post)) post (cdr (previous-post post))))
(define (letter-in-mailbox? letter)
(if (member (post letter) T) #t #f))
(define (add-post letter)
(begin (set! T (cons letter T)) 'done))
(define (get-previous-post post)
(if (letter-in-mailbox? post)
(previous-post post)
#f))
(define (dispatch y)
(cond ((eq? y 'add-letter) add-post)
((eq? y 'get-latest-message) (get-previous-post T))
((eq? y 'get-address) address)
(else "Invalid option.")))
dispatch))
After being given a very good explanation on what my current answer was doing wrong and making many necessary changes to my code, I was told that any problems I have in that code would be better off asked in this question. Therefore, here is the code that builds off my previous question:
(define (make-mailman)
(let ((self (list '(ROUTE) '(MAILBAG))))
(define (add-to-route . mailboxes)
(let ((route (assoc 'ROUTE self)))
(set-cdr! route (append mailboxes (cdr route)))
'DONE))
(define (collect-letters . letters)
(let ((mailbag (assoc 'MAILBAG self)))
(set-cdr! mailbag (append letters (cdr mailbag)))
'DONE))
(define (distribute-the-letters)
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters)
()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
(let* ((address (letter 'get-address))
(mbx (find-mailbox address mailboxes)))
(if (equal? address letter)
((mbx 'add-post) letter)
((mbx 'add-post) not-delivered))
(if (null? letters)
(begin (set-cdr! mailbag '()) not-delivered)
(loop (car letters) (cdr letters) not-delivered)))))))
(define (dispatch z)
(cond ((eq? z 'add-to-route) add-to-route)
((eq? z 'collect-letters) collect-letters)
((eq? z 'distribute) distribute-the-letters)
(else "Invalid option")))
dispatch))
Essentially, I'm running into a different error now that instead returns that the distribute-the-letters procedure is being passed as an argument to length, which is not a list. I do not know why this error is being returned, since I would think that I am passing in the lists as they are needed. Would anyone be able to shed some light on what's going on? Any help will be appreciated.
UPDATE: Using this procedure in my make-mailman code now:
(define (find-mailbox address mailbox)
(if (not (element? address self))
#f
(if (element? mailbox self)
mailbox
#f)))
Your error is here:
(define (distribute-the-letters)
(let* ((mailbag (assoc 'MAILBAG self))
(mailboxes (cdr (assoc 'ROUTE self)))
(letters (cdr mailbag)))
(if (null? letters)
()
(let loop ((letter (car letters))
(letters (cdr letters))
(not-delivered ()))
(let* ((address (letter 'get-address))
(mbx (find-mailbox address mailboxes))) ;; has to be impl'd
;; (if (equal? address letter) ;; this makes
;; ((mbx 'add-post) letter) ;; no
;; ((mbx 'add-post) not-delivered)) ;; sense
;; here you're supposed to put the letter into the matching mailbox
;; or else - into the not-delivered list
(if mbox ;; NB! find-mailbox should accommodate this
((mbox 'put-letter) letter) ;; NB! "mailbox" should accom'te this
(set! not-delivered ;; else, it wasn't delivered
(cons letter not-delivered)))
(if (null? letters)
(begin
(set-cdr! mailbag '()) ;; the mailbag is now empty
not-delivered) ;; the final return
(loop (car letters)
(cdr letters)
not-delivered)))))))
find-mailbox still has to be implemented here. It should search for the matching mailbox, and return #f in case it is not found, or return the mailbox object itself if it was found. The "mailbox" objects must be able to respond to 'put-letter messages and have "addresses". The "letter" objects must also have "addresses" (which we retrieve with the call (letter 'get-address), and for mailbox we'd call (mbox 'get-address)), and these addresses must be so that we can compare them for equality.
That means that letters and mailboxes should be objects defined through the same kind of procedure as here the mailman is defined, with internal procedures, and the dispatch procedure exported as the object itself.
This all needs to be further implemented, or perhaps you have them already as part of some previous assignment?
now that you've provided your additional definitions, let's see.
make-letter seems OK. A letter supports two messages: 'get-destination and get-message.
make-mailbox has issues.
(define (make-mailbox address)
(let ((T '()))
(define (post letter)
(assoc letter T)) ;; why assoc? you add it with plain CONS
(define (previous-post post)
(if (null? (cdr post)) ;; post == T (11)
post
(cdr (previous-post post) ;; did you mean (prev-p (cdr post)) ? (12)
)))
(define (letter-in-mailbox? letter) ;; letter == T ??????? (3)
(if (member (post letter) T) #t #f))
(define (add-post letter)
(begin (set! T (cons letter T)) 'done)) ;; added with plain CONS
(define (get-previous-post post)
(if (letter-in-mailbox? post) ;; post == T (2)
(previous-post post) ;; post == T (10)
#f))
(define (dispatch y)
(cond ((eq? y 'add-letter) add-post)
((eq? y 'get-latest-message)
(get-previous-post T)) ;; called w/ T (1)
((eq? y 'get-address) address)
(else "Invalid option.")))
dispatch))
you add letters with add-post, and it calls (set! T (cons letter T)). So it adds each letter into the T list as-is. No need to use assoc to retrieve it later, it's just an element in a list. Just call (member letter T) to find out whether it's in. post has no function to perform, it should be (define (post letter) letter).
(if (member letter T) #t #f) is functionally the same as just (member letter T). In Scheme, any non-false value is like a #t.
Your previous-post (if fixed w/ (12) ) returns the last cdr cell of its argument list. If it holds letters (a b c d), (previous-post T) returns (d). Didn't you mean it to be a ? The message it handles is called 'get-latest-message after all. Whatever you just added with cons into list ls, can be gotten back with one simple call to ... (what?).
And why is it called get-latest-message? Does it return a letter, or the message within that letter? (and here the word message is used in two completely unrelated senses in one program; better call letter's contents, maybe, letter-contents ??
Lastly, we call (find-mailbox address mailboxes) in the main program, but you define (define (find-mailbox address mailbox) .... It should compare (equal? address (mailbox 'get-address)). self isn't needed, so this utility function can be put into global scope.
And it must enumerate through those mailboxes:
(define (find-mailbox address mailboxes)
(if (not (null? mailboxes))
(if (equal? address ((car mailboxes) 'get-address))
(car ..... )
(find-mailbox address .... ))))
I have a problem with common lisp.
I want to pass a string to a function
and want that this strings become a structure.
I can't use external library.
For example with this input:
(testfu "ftp/http.ok:3345")
This is the struct:
(defstruct test-struct
scheme
part
ans
port)
I want this result:
scheme: "ftp" part: "http" ans "ok" port "3345"
How can I do the testfu ?
here my bad try :(
(defun testfu (x)
(setq ur1 (make-test-struct :scheme frist x :host second x)))
I'd recommend using a regex to parse this. Using CL-PPCRE which is the Common Lisp regex library, the code would look like this:
(defun testfu (x)
(multiple-value-bind (result values)
(ppcre:scan-to-strings "^([a-z]+)/([a-z]+)\\.([a-z]+):([0-9]+)$" x)
(unless result
(error "String ~s is not valid" x))
(make-test-struct :scheme (aref values 0)
:part (aref values 1)
:ans (aref values 2)
:port (aref values 3))))
Note that you probably would have to adjust the regex to better represent the actual format of the input string, in particular if any of the fields are optional.
You will have to parse the data out of the string in order that you might use it for your strut. Lisp won't do that magically.
Split Sequence is a good library for doing that
If you don't want a library, then some code to get you on the correct track. This will tokenize string based on a predicate function fn ( which returns true when a character is a delimiter and false otherwise )
(defun split-by-fn (fn string)
(let* ((STARTING 0)
(TOKEN 1)
(DELIM 2)
(state STARTING)
(a-token "")
(the-list '())
(str-length (length string)))
(dotimes (i str-length)
(if (funcall fn (char string i))
(progn
(if (eq state TOKEN)
(progn
(setq the-list (cons a-token the-list))
(setq a-token "")))
(setq state DELIM))
(progn
(setq a-token
(concatenate 'string a-token (string (char string i))))
(setq state TOKEN))))
(if (eq state TOKEN)
(setq the-list (cons a-token the-list)))
(setq the-list (reverse the-list))))
I don't usually write code for people but here is an example parser, it's not the most lisp-y, there are better ways of doing this, but it works.
(defun parser ( string )
(labels ((set-field (state struct token)
(let ((SCHEME 0)
(PART 1)
(ANS 2)
(PORT 3))
(cond ((= state SCHEME)
(setf (example-struct-SCHEME struct) token))
((= state PART)
(setf (example-struct-PART struct) token))
((= state ANS)
(setf (example-struct-ANS struct) token))
((= state PORT)
(setf (example-struct-PORT struct) token))))))
(let ((state 0)
(token "")
(check 0)
(a-list '())
(struct (make-example-struct)))
(loop for char across string do
(progn
(setq check (position char "/.:"))
(if check
(progn
(set-field state struct token)
(setq token "")
(setq state (+ check 1)))
(setq token (concatenate 'string token (string char))))))
(progn
(if (/= 0 (length token))
(set-field state struct token))
struct))))