How to get Emacs to sort lines by length? - sorting
I'd like to be able to highlight a region in Emacs and then sort the region by line length.
The closest I've found is the following code which I think will sort by length:
(sort-subr t #'forward-line #'end-of-line nil nil
(lambda (l1 l2)
(apply #'< (mapcar (lambda (range) (- (cdr range) (car range)))
(list l1 l2)))))
But I don't know how to turn this into an interactive function that lets me use it by highlighting a region. Can someone help?
You can combine the sort-lines command definition with your snippet to form a new command:
(defun sort-lines-by-length (reverse beg end)
"Sort lines by length."
(interactive "P\nr")
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(let ;; To make `end-of-line' and etc. to ignore fields.
((inhibit-field-text-motion t))
(sort-subr reverse 'forward-line 'end-of-line nil nil
(lambda (l1 l2)
(apply #'< (mapcar (lambda (range) (- (cdr range) (car range)))
(list l1 l2)))))))))
Related
Why do I get "application: not a procedure" with this for loop in Racket?
The following code reads a csv file and based on its content generates a Prolog program:
#!/usr/bin/env racket
#lang racket/base
(define (overwrite-s-to-f fname s); Will create fname and write overwriting the previous content.
(with-output-to-file #:exists 'truncate fname (lambda () (displayln s))))
(define (c-o-a-line-to-f fname s); Will append a string to fname or create it if does not exist. Appends a new line.
(with-output-to-file #:exists 'append fname (lambda () (displayln s))));
(define fname "women.csv")
(define pl-fname "females-by-Racket.pl")
(require racket/file)
(define content (file->lines fname))
(define disc-line (string-append ":-discontiguous(" (string-replace (car content) "Name," "") ").\n"))
(overwrite-s-to-f pl-fname disc-line)
(define list-of-verbs (string-split (string-replace (car content) "Name," "") ","))
(require racket/string racket/system)
(for ((row content));content is a list of strings
(let ((list-of-cs (string-split row ",")))
(when (equal? (car (cdr list-of-cs)) "+")
(displayln row)(let ((cmd (string-append "awesome("(car list-of-cs)").")))(c-o-a-line-to-f pl-fname cmd)(displayln cmd)))
(when (equal? (car (cdr (cdr list-of-cs))) "+")(displayln row)(let ((cmd (string-append "and_intelligent("(car list-of-cs)").")))
(c-o-a-line-to-f pl-fname cmd)(displayln cmd))))); TODO: when for each columns 2-last of women.csv
The content of women.csv:
Name,awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts
adriana_chechik,+,,,+,?,+,+,,-,,,,,
alysa_gap,+,,,,?,+,+,,-,,,,,
anna_de_ville,+,,,,,+,+,,+,-,+,-,-,
aurora_jolie,+,+,,,,,,,+,+,+,,+,
autumn_falls,,,,,,,,,+,+,-,+,+,
casey_calvert,+,,,,,,,,+,+,+,,,
dahlia_sky,+,,,,,,+,,,,,,,
dominica_lito,+,,,,,,+,,,,,,,
ella_knox,,,,,,,,,+,+,+,,+,
isabella_clark,+,,,,,,+,,,,,,,
jade_kush,,,,,,,,,+,+,,,+,
juelz_ventura,+,,,,,+,,,-,-,,,-,+
kapri_styles,,,,,,,,,+,,+,,,
kristina_milan,,,,,,,,,+,+,,,+,
kylie_sinner,+,+,,,,,,,+,,,,-,
leigh_raven,+,,,,,+,,,+,+,,,,
maserati,,,,,,,,,+,+,,,+,
miosotis,,,,,,,,,+,+,,,+,
scarlett_bloom,,,,,,,,,+,+,+,,-,
sheena_shaw,,,,,,,,,-,,+,,-,
sofia_rose,,,,,,,,,+,,,,+,
teanna_trump,+,,,,,,,,+,,+,,,
veronica_avluv,+,,,,,,+,,,,,,,
yudi_pineda,+,,,,,,,,+,+,,,,
females-by-Racket.pl is to look like so:
:-discontiguous(awesome,and_intelligent,performed_once,extreme1,extreme2,extreme3,extreme4,donkey_thing,dark_eyes,pigmented_face,pigmented_genitals,bleached,had_no_surgeries,has_augmented_breasts).
awesome(adriana_chechik).
awesome(alysa_gap).
awesome(anna_de_ville).
awesome(aurora_jolie).
and_intelligent(aurora_jolie).
awesome(casey_calvert).
awesome(dahlia_sky).
awesome(dominica_lito).
awesome(isabella_clark).
awesome(juelz_ventura).
awesome(kylie_sinner).
and_intelligent(kylie_sinner).
awesome(leigh_raven).
awesome(teanna_trump).
awesome(veronica_avluv).
awesome(yudi_pineda).
but with more predicates (up to n-1 for each woman where n is the number of columns in women.csv)
The names of the columns or the numbers thereof in women.csv are likely to be frequently changed.
That is partly why I wish to avoid manually coding for every when. The other concerns are the sheer amount of the lines to code (15 whens for each column) and the risk of error/typo.
Is it doable to loop through every cell in list-of-cs in such way that it is taken from list-of-verbs?
I've tried this but to no avail (the comment show the error message that I got):
(for ((row content))
(let ((list-of-cs (cdr (string-split row ","))))
(for ((cell list-of-cs))
; application: not a procedure; expected a procedure
; that can be applied to arguments
(set! list-of-verbs (cdr (list-of-verbs)))
(let ((verb (car list-of-verbs)))
(when (equal? cell "+")
(displayln row)
(let ((cmd (string-append verb "(" (car row) ").")))
(c-o-a-line-to-f pl-fname cmd)))
))))
named let is a useful form to be familiar with:
#lang scheme
(define (csv->attributes rows) ;; ListOfString -> ListOfString
;; produce "column-header(row-name)" for "+" entries in csv (see example)
(let ([fields (string-split (car rows) ",")])
(let next-row ([rows (cdr rows)] [result (list)])
(cond
[(null? rows) (reverse result) ]
[else
(let* ([cells (string-split (car rows) ",")]
[name (car cells)])
(let next-cell ([cells (cdr cells)] [fields (cdr fields)] [result result])
(cond
[(null? cells) (next-row (cdr rows) result) ]
[else (next-cell
(cdr cells) (cdr fields)
(if (string=? (car cells) "+")
(cons (string-append (car fields) "(" name ")") result)
result)) ]))) ]))))
(define trio '("Name,fast,slow,sidles"
"Achilles,+,,"
"Tortoise,,+,"
"Crab,,+,+"))
Welcome to DrRacket, version 8.5 [cs].
Language: scheme, with debugging.
> (csv->attributes trio)
("fast(Achilles)" "slow(Tortoise)" "slow(Crab)" "sidles(Crab)")
>
scheme, sicp, solution 3.19, procedure with infinite loop works in case it is provided as argument
could someone help me with clarification to one of the possible solution to exercise 3.19. the procedure mystery is infinite loop in case list cycle is given as argument. nevertheless when we use procedure eq? to check if list contains the cycle, it works and provides true value. (define (last-pair x) (if (null? (cdr x)) x (last-pair (cdr x)) ) ) (define (make-cycle x) (set-cdr! (last-pair x) x) ) (define (mystery x) (define (loop x y) (if (null? x) y (let ((temp (cdr x))) (set-cdr! x y) (loop temp x) ) ) ) (loop x '()) ) (define t (list 1 2 3)) (define w (make-cycle t)) (eq? (mystery t) t) it looks like magic. I would appreciate for any help.
mystery reverses an array "in-place" by repeatedly snipping off the cdr of each entry and replacing that with the cdr of the previous x.
If this list has no loop, then it will end up reversed by the time you get back to the original '(). If there is a loop, you'll have the original array's pointer.
This is definitely a tricky to understand issue. If you make a box-and-pointer diagram it will definitely help and you'll only need to draw 3 diagrams.
Automatically Generating Diagrams of Lists
In the process of doing SICP myself, I found myself wanting a way to visualize list mutation (and to skip the numerous "draw a list diagram of..." exercises). I wrote a small function for doing so and I thought you might find it helpful if I shared it.
These diagrams are an example of this function being run on x each time loop (within the mystery function) is ran.
The following code is what I used for generating these diagrams. I wrote this code as a Scheme novice, but it's very simple to use: the function (list->graphviz) accepts a parameter lst which is the list you'd like a diagram of, as well as an optional argument graph-name which gives the graph a special name.
(define* (list->graphviz lst #:optional graph-name)
"""Convert a list into a set of Graphviz instructions
`lst' is the list you'd like a diagram of
`graph-name` is an optional parameter indicating the name you'd like to give the graph."""
(define number 0)
(define result "")
(define ordinals '())
(define (result-append! str)
(set! result (string-append result str)))
(define* (nodename n #:optional cell)
(format #f "cons~a~a" n (if cell (string-append ":" cell) "")))
(define* (build-connector from to #:optional from-cell)
(format #f "\t~a -> ~a;~%" (nodename from from-cell) (nodename to)))
(define (build-shape elt)
(define (build-label cell)
(cond ((null? cell) "/");; "∅") ; null character
((pair? cell) "*");; "•") ; bullet dot character
(else (format #f "~a" cell))))
(set! number (+ number 1))
(format #f "\t~a [shape=record,label=\"<car> ~a | <cdr> ~a\"];~%"
(nodename number)
(build-label (car elt))
(build-label (cdr elt))))
(define* (search xs #:optional from-id from-cell)
(let ((existing (assq xs ordinals)))
(cond
;; if we're not dealing with a pair, don't bother making a shape
((not (pair? xs)) (result-append! "\tnothing [shape=polygon, label=\"not a pair\"]\n"))
((pair? existing)
(result-append! (build-connector from-id (cdr existing) from-cell)))
(else
(begin
(result-append! (build-shape xs))
(set! ordinals (assq-set! ordinals xs number))
(let ((parent-id number))
;; make a X->Y connector
(if (number? from-id)
(result-append! (build-connector from-id parent-id from-cell)))
;; recurse
(if (pair? (car xs)) (search (car xs) parent-id "car"))
(if (pair? (cdr xs)) (search (cdr xs) parent-id "cdr"))))))))
(search lst)
(string-append "digraph " graph-name " {\n" result "}\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Here is where `mystery' begins ;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define t '(1 2 3))
(set-cdr! (cddr t) t)
(define (mystery x)
(define (loop x y graph-num)
(display (list->graphviz x (format #f "graph~a" graph-num)))
(if (null? x)
y
(let ((temp (cdr x)))
(set-cdr! x y)
(loop temp x (+ 1 graph-num)))))
(loop x '() 0))
(mystery t)
The code above code generates Graphviz graph description statements, which must then be processed by dot (Graphviz) to be rendered to a graphical format.
For example, you can run the code above and pipe it into dot:
$ scheme generate_box_ptr.scm | dot -o ptrs.ps -Tps
This command generates a postscript file which has the advantage of separating each list into it's own page if you've run list->graphviz more than once. dot can also output PNGs, PDFs and many other file formats as the manpage describes.
Scheme and Merge Sort?
I was assigned to write a merge sort in Scheme but I have some issues with it. I showed it my professor and he said there is one simple mistake. Can someone help me? Plzz! (define msort (lamdba(1st) (cond ((null?? 1st) 1st) ((null? (cdr 1st)) 1st) (#t ((letrec ((half (quotient (lenght 1st) 2)) (merge (lamdba (a b result) (cond ((null? a) (apped (reserve a) result)) ((null? b) (append (reserve a) result)) ((> (car a) (car b) (merge a (cdr b) (cons (car b) result)) (#t (merge (cdr a) b (cons (car a) result))))))) (merge (msort (take 1st half)) (msort (drop 1st half)) '()))))))
One simple mistake? He probably referred to #1, but even after fixing that you have some identifiers and parenthesis to fix: lambda, null?, length, append, and reverse is spelled incorrectly. letrec result gets applied since you have excess parenthesis around it. cond in merge where you compare elements are missing parenthesis two places. It's obvious you need help with parenthesis matching so you should download a decent IDE to write code in. I use DrRacket for Scheme development (#!R5RS, #!R6RS and #!racket) and it idents (just press CTRL+i to get it reidented after pasting in code) and indicate where function names are written wrong when you hit RUN. Making merge a global function in the beginning and perhaps move it to a letrec later (if you have to) might ease development. Eg. you could find errors by testing stuff like (merge '(3 2 1) '()). This is no guarantee the program will work since I only address syntax here. You need to debug it! DrRacket has a debugger too!
I think it is useful to implement first a function that allow to merge two ordered lists: (define (merge l1 l2) (if (empty? l1) l2 (if (empty? l2) l1 (if (< (car l1) (car l2)) (cons (car l1) (merge (cdr l1) l2)) (cons (car l2) (merge l1 (cdr l2))))))) Now assume we have a function (get ls pos) capable to return the element of ls in position pos: (define (get ls pos) (if (= pos 1) (car ls) (get (cdr ls) (- pos 1)))) Finally, we can implement mergesort function: (define (mergesort l p r) (if (= p r) (cons (get l p) empty) (merge (mergesort l p (floor (/ (+ p r) 2))) (mergesort l (+ (floor (/ (+ p r) 2)) 1) r))))
little human like text searching program in scheme
I am trying to make little human like text searching program in scheme but this program doesn't work properly time to time and I can't catch the bug for many hours could somebody tell me what's wrong with my code? and is it not that good idea for searching text? when I search the string "exp" in the text file which contain nothing but just string "explorer" error arise and it tells Found 0 (define (search str) (set! count 0) (define len (length str)) ;null character calculating (define data-len (- (length data) 1)) ;when string length is less than or equal to data-length (when (and (not (= 0 len)) (>= data-len len)) (define first-char (first str)) (define last-char (last str)) ;is it correct? (define (exact? str len index) (if (equal? str (drop (take data (+ index len)) index)) #t #f)) ;check first and last character of string if correct, check whether this string is correct completely, if so, skip to next index (define (loop [index 0]) (when (> data-len index) (if (and (equal? first-char (list-ref data index)) (equal? last-char (list-ref data (+ index len -1)))) (when (exact? str len index) (set! count (+ count 1)) (loop (+ index len))) (loop (+ index 1))))) (loop)) (send msg set-label (format "Found : ~a" count)))
I know it's been four years, but I'm nostalgic for my SCHEME class, so I made a thing. (I'd comment instead of answering, but I don't have enough reputation yet. ... And I'm probably about to have less.) (define (find-pattern pat str); Returns a list of locations of PATturn in STRing. (define (pattern-found? pat-list str-list); Is the pattern (pat-list) at the beginning of this string (str-list)? Also, they're lists, now. (cond ((null? pat-list) #t); The base case for the recursion. ((null? str-list) #f); Obvious ((eq? (car pat-list) (car str-list)); First letter matches (pattern-found? (cdr pat-list) (cdr str-list))); Recurse (else #f))) (define (look-for-pattern pat-list str-list counter results-list) (cond ((null? str-list) results-list); Base case ((pattern-found? pat-list str-list) (look-for-pattern pat-list (cdr str-list) (+ counter 1) (cons counter results-list))) (else (look-for-pattern pat-list (cdr str-list) (+ counter 1) results-list)))) (look-for-pattern (string->list pat) (string->list str) 0 '())) EDIT: I mean it's been four years since the question, not since SCHEME class. That'd be a little creepy, but then again, who knows how I'll feel in three years?
go through an sxml file in schme
im trying to load a sxml file... i manage to do that in scheme. now i want to go through it using recursion and located items that i want. my code is like this, (define file (read(open-input-file "test1.sxml"))) (define myfunc (lambda (S) (if (eq? "foo" (car S)) (display "found\n") (display "not found\n") ) (if (null? (cdr S)) (display "\n") (myfunc(cdr S))))) but it seems that it goes through only the first line of the sxml file. how can i make it go through all the file until the end?
1) You need to search through all of the sublists of the structure. Your code right now only looks at the top-most elements. 2) You usually don't want to have multiple statements in a row (like your two if statements) 3) You probably want to look for symbols, not strings, in your SXML file. Regardless, you must use equal? to compare strings. Thus, your function becomes (define myfunc (lambda (S) (cond ((null? S) #f) ((pair? (car S)) (or (myfunc (car S)) (myfunc (cdr S)))) ; search on sublists ((equal? "foo" (car S)) #t) ; if found, return true (else (myfunc (cdr S))))))