I am currently using Dr Racket to do the programming and the task that I am required to do is to give a prompt to a user for an input file. Using the integer values in the input file, the program will execute two functions (two-lhs and two-rhs) that calculates sum of N squares, and output the result to a prompted output file; having the value from two-lhs to be listed on the left side and the value from two-rhs on the right side.
For example: suppose there is a file named 'data' in the directory where line one has the integer 25 and line two has 7, and line three has 9. User that inputs 'data' as an input file and 'testing' as an output file, the output file named 'testing' will be created in the directory with following values and format:
(results from two-lhs) (results from two-rhs)
5525 5525
140 140
285 285
This is my current code with comments of my understanding:
#lang racket
(define squared ;helper function for two lhs
(lambda (x) (* x x)))
(define Two-LHS
(lambda (n)
(cond((= n 0) 0)
(else
(+ (squared n) (Two-LHS(- n 1)))))))
(define Two-RHS
(lambda (n)
(cond ((= n 0) 0)
(else
(/ (* n (+ n 1) (+ (* n 2) 1)) 6)))))
(define in ;function that reads in the input file from user
(lambda ()
(let((pin(open-input-file (symbol->string (read))))) ;prompts the user for input file. pin = the input-port
(let f ((x(read pin))) ;f is a procedure that reads the input port?
(if(eof-object? x) ; x reads the value inside pin and if x happens to be end of file object
(begin ; then closes the input-port
(close-input-port pin)
'())
(cons (Two-LHS x)(cons (Two-RHS x)(f(read pin))))) ;else using the x, executes two lhs and rhs until x reaches
)))) ; end of file to close the port
(define write-lst
(lambda (lst outp) ;lst = input file, outp = output file
(if(eq? lst '()) ; if input file contains an empty list
(close-output-port outp) ; the output-port will be closed
(begin ; else execute begin
(write (car lst) outp) ; which writes the first element of the list to the output file
(display #\space outp) ; will add whitespace after each element to the output file.
(newline outp) ; was thinking this would add newline on the output file after each iteration, but need a way to add newline after every 2 whitespace.
(write-lst (cdr lst) outp))))) ;recurses back to write-lst function with the next element in the list without
;the first element until it becomes an empty list so that output-port could close.
(define out ;will be renamed to two-sum, since this is the function that will write to the output file.
(lambda (lst) ;lst = input file
(let((pout(open-output-file (symbol->string (read))))) ; prompts the user for the output file, pout = the output-port
(write-lst lst pout); uses write-list function to write out to output file
)))
(out (in))
The output file I get running my code is:
5525
5525
140
140
285
285
How can I make the output file to be formatted correctly?
Any help in the right direction would be extremely appreciated!
Thank you.
We can levarage Racket's fprintf procedure to make things easier, and iterate over the list two elements at a time - assuming that it has an even number of elements:
(define write-lst
(lambda (lst outp)
(if (null? lst)
(close-output-port outp)
(begin
(fprintf outp "~a ~a~n" (car lst) (cadr lst))
(write-lst (cddr lst) outp)))))
The trick is here, in the format string: "~a ~a~n". It states: print an object, a whitespace, another object and a new line. And we pass the current element (car lst) and the second element (cadr lst) - in fact, we could just use the first and second procedures, which are easier to understand. Finally, in the recursion we advance two elements: (cddr lst).
We are trying to implement a Draft Sight/AutoCad script that will transform a SVG file into a CAD drawing.
The principal idea is to read the file line by line (performed by ReadSVGData), split the svg definitions by spaces (ReadHTMLItemData), read the individual HTML attributes into a list and based on the type of the SVG item draw a CAD element. So much in regards to the principal...
The unususal part is, that whenever the Html Attributes, like "id="Box_8_0"" are sent to the findchar function, by attrlis function, the script fails, although the same arrangement went well before
Does anybody have a hint where my mistake is hidden?
(defun findchar (FindChar Text)
(setq
;current location in string
coord 1
;Init Return Coordinate
ReturnCoord 0
;Length of Searched Item, to enable string searching
FindCharLen (strlen FindChar)
;Nil Count: Requires as regular expressions like (/t) are identified as two times ascii char 9
NilCnt 0
;Storage of last Char Ascii to identify regular expressions
LastCharAsci -1
)
;iterate the String and break in case of the first occurence
(while (and (<= coord (strlen Text) ) (= ReturnCoord 0))
;Current Character
(setq CurChar (substr Text coord FindCharLen))
;Find Searched String
(if (= FindChar CurChar)
(setq ReturnCoord coord)
)
;Check for regular expression
(if (and (= LastCharAsci 9) (= (ascii CurChar) 9))
(setq NilCnt (+ NilCnt 1))
)
;Update String position and String
(setq LastCharAsci (ascii CurChar))
(setq coord (+ coord 1))
)
;return variable
(- ReturnCoord NilCnt)
)
(defun attrlis (HTMLAttr)
(setq Koordi 0)
(progn
(setq CharLoc (findchar "<" HTMLAttr))
(princ HTMLAttr)
(terpri)
)
(+ Koordi 1)
)
(defun ReadHTMLItemData(HTMLItem)
(setq
coord 1
HTMLItmBgn 1
Attributes 0
CurChar 0
Dictionary 0
)
;(princ HTMLItem)
;(terpri)
(while (<= coord (strlen HTMLItem))
(setq CurChar (substr HTMLItem coord 1))
(if (or (= (ascii CurChar) 32) (= (ascii CurChar) 62))
(progn
(if (> (- coord HTMLItmBgn) 0)
(progn
(setq htmlattr (substr HTMLItem HTMLItmBgn (- coord HTMLItmBgn)))
(setq Result (attrlis htmlattr))
(princ Result)
(setq HTMLItmBgn (+ coord 1))
)
)
)
)
(setq coord (+ coord 1))
)
)
(defun ReadLineContents(Line)
(if (/= Line nil)
(progn
;(princ Line)
;(terpri)
(setq
Bgn (findchar "<" Line)
End (findchar ">" Line)
ItemDef (substr Line (+ Bgn (strlen "<")) End)
)
(ReadHTMLItemData ItemDef)
)
)
)
(defun C:ReadSVGData()
(setq SVGFile (open (getfiled "Select a file" "" "svg" 0) "r"))
(setq Line 1)
(while (/= Line nil)
(setq Line (read-line SVGFile))
(ReadLineContents Line)
)
(close SVGFile)
(princ "Done")
)
Reading the following file:
<svg class="boxview" id="boxview" style="width:1198.56px; height:486.8004px; display:block;" viewBox="0 0 1198.56 486.8004">
<g id="BD_box">
<rect class="box" id="Box_8_0" x="109.21" y="394.119" width="58.512" height="62.184" box="4047"></rect>
</g>
</svg>
EDIT
Change of substring Index, based on satraj's answer
The problem lies in the way the "substr" Autolisp function is used. The start index of substr always starts from index 1 (not from 0). So your code must be changed such that the start index are initialized as 1. The following lines in your code fails.
(setq CurChar (substr HTMLItem coord 1))
(setq htmlattr (substr HTMLItem HTMLItmBgn (- coord HTMLItmBgn)))
Since coord and HTMLItemBgn variables are initialized as 0, the substr function fails.
Also, why not use "vl-string-search" function if you want to find the position of a text in a string? you can get rid of the findchar function.
An Example:
(setq CharLoc (vl-string-search "<" HTMLAttr))
In general, if you want to debug failures in AutoLisp, add the following function to your lisp file and it will print a stack trace in case of failures, which will enable you to locate exact place where the error occured.
(defun *error* (msg)
(vl-bt)
)
In Emacs or Vim, what's a smooth way to join strings as in this example:
Transform from:
(alpha, beta, gamma) blah (123, 456, 789)
To:
(alpha=123, beta=456, gamma=789)
It would need to scale to:
many lines of these
many elements in the parentheses
I have recently found myself needing this kind of transformation often.
I use Evil in Emacs which is why a Vim answer would likely also help.
UPDATE:
The solutions were not as general as I had hoped. For example, I'd like the solution to also work when I have a list of strings and wish to distribute them into a large XML document. eg:
<item foo="" bar="barval1"/>
<item foo="" bar="barval2"/>
<item foo="" bar="barval3"/>
<item foo="" bar="barval4"/>
fooval1
fooval2
fooval3
fooval4
I formulated a solution and have added it as an answer.
%s/(\(\S\{-}\), \(\S\{-}\), \(\S\{-}\)).\{-}(\(\S\{-}\), \(\S\{-}\), \(\S\{-}\))/(\1=\4, \2=\5, \3=\6)
%s: global search and replace
\(\S{-}\),: non greedy search for non-whitespace characters up to the next comma, enclosed by "(" for backreferencing
\1=\4 : prints out the first match, an "=" sign, then the fourth match
for such text transformation, I would go with awk:
this one-liner may help:
awk -F'\\(|\\)' '{split($2,t,",");split($4,v,",");printf "( "; for(x in t)s=s""sprintf("%s=%s, ", t[x],v[x]);sub(", $","",s);printf s")\n";s=""}' file
little test:
kent$ cat test
(alpha, beta, gamma) blah (123, 456, 789)
(a, b, c) foo (1, 2, 3)
(x, y, z, m, n) bar (100, 200, 300, 400, 500)
kent$ awk -F'\\(|\\)' '{split($2,t,",");split($4,v,",");printf "( "; for(x in t)s=s""sprintf("%s=%s, ", t[x],v[x]);sub(", $","",s);printf s")\n";s=""}' test
( alpha=123, beta= 456, gamma= 789)
( a=1, b= 2, c= 3)
( m= 400, n= 500, x=100, y= 200, z= 300)
Emacs Lisp version of Prince Goulash answer
(require 'cl)
(defun split-and-trim (str separator)
(let ((strs (split-string str separator)))
(mapcar (lambda (s)
(replace-regexp-in-string "^\\s-+" "" s))
(mapcar (lambda (s)
(replace-regexp-in-string "\\s-$" "" s)) strs))))
(defun my/merge-list (beg end)
(interactive "r")
(goto-char beg)
(let ((endmark (set-mark end))
(regexp "(\\([^)]+\\))[^(]+(\\([^)]+\\))"))
(while (re-search-forward regexp end t)
(let ((replace-start (match-beginning 0))
(replace-end (match-end 0))
(keys-str (match-string-no-properties 1))
(values-str (match-string-no-properties 2)))
(let* ((keys (split-and-trim keys-str ","))
(values (split-and-trim values-str ",")))
(while (> (length keys) (length values))
(setq values (append values '(""))))
(let* ((pairs (mapcar* (lambda (k v)
(format "%s=%s" k v)) keys values))
(transformed (format "(%s)" (mapconcat #'identity pairs ", "))))
(goto-char replace-start)
(delete-region replace-start replace-end)
(insert transformed)))))
(goto-char (marker-position endmark))))
For example, you select region as following
(alpha, beta, gamma) blah (123, 456, 789)
(alpha, beta, gamma, delta) blah (123, 456, 789, aaa)
After M-x my/merge-list
(alpha=123, beta=456, gamma=789)
(alpha=123, beta=456, gamma=789, delta=aaa)
This method I'm going to describe is a bit wacky, but it involves the minimum amount of Elisp code I could manage. It's only applicable if the lists to be joined can be interpreted as Lisp lists once the commas in them are removed. Numbers and sequences of alphabetic characters, as in your example, would be fine.
First, make sure that the Common Lisp library is loaded: M-:(require 'cl)RET.
Now, starting with the cursor at the start of the first list:
M-C-k ; kill-forward-sexp
C-e ; move-end-of-line
M-C-b ; backward-sexp
M-C-k ; kill-forward-sexp
C-a ; move-beginning-of-line
C-k ; kill-line
Now blah (or whatever) is the first entry in the kill ring, the second list is the second entry, and the first list is the third entry.
Type (, then M-: (eval-expression), take a deep breath, and type this:
(loop with (a b) = (mapcar (lambda (x) (car (read-from-string (remove ?, x))))
(subseq kill-ring 1 3))
for x in a for y in b do (insert (format "%s=%s, " y x)))
(I've broken it up for presentation purposes, but you can type it all on one line.)
Then finally DELDEL), and you're done! You could turn it into a macro, if you wanted.
Here is a Vimscript solution. It is nowhere near as elegant as ash's answer, but it works with lists of any length.
function! ListMerge()
" Get line, remove text between lists, split lists at parentheses:
let curline = getline('.')
let curline = substitute(curline,')\zs.*\ze(','','g')
let curline = substitute(curline,'(','','g')
let lists = map(split(curline,')'),'split(v:val,",")')
" Return if we don't have two lists of equal length:
if len(lists) != 2 || len(lists[0]) != len(lists[1])
return
endif
" Loop over the lists, remove whitespace, build the replacement string:
let i=0
let string = '('
while i<len(lists[0])
let string .= substitute(lists[0][i],'^ *','','')
let string .= '='
let string .= substitute(lists[1][i],'^ *','','')
let string .= ', '
let i+=1
endwhile
" Add the concluding bracket:
let string = substitute(string,', $',')','')
" Replace the current line with the string:
execute "normal! S" . string
endfunction
You can then call this function on all lines like this:
:%call ListMerge()
My approach is to create one command to set a match-list, then use replace-regexp as the second command to distribute match-list, leveraging replace-regexp's existing \, facility.
Evaluate Elisp, such as in the .emacs file:
(defvar match-list nil
"A list of matches, as set through the set-match-list and consumed by the cycle-match-list function. ")
(defvar match-list-iter nil
"Iterator through the global match-list variable. ")
(defun reset-match-list-iter ()
"Set match-list-iter to the beginning of match-list and return it. "
(interactive)
(setq match-list-iter match-list))
(defun make-match-list (match-regexp use-regexp beg end)
"Set the match-list variable as described in the documentation for set-match-list. "
;; Starts at the beginning of region, searches forward and builds match-list.
;; For efficiency, matches are appended to the front of match-list and then reversed
;; at the end.
;;
;; Note that the behavior of re-search-backward is such that the same match-list
;; is not created by starting at the end of the region and searching backward.
(let ((match-list nil))
(save-excursion
(goto-char beg)
(while
(let ((old-pos (point)) (new-pos (re-search-forward match-regexp end t)))
(when (equal old-pos new-pos)
(error "re-search-forward makes no progress. old-pos=%s new-pos=%s end=%s match-regexp=%s"
old-pos new-pos end match-regexp))
new-pos)
(setq match-list
(cons (replace-regexp-in-string match-regexp
use-regexp
(match-string 0)
t)
match-list)))
(setq match-list (nreverse match-list)))))
(defun set-match-list (match-regexp use-regexp beg end)
"Set the match-list global variable to a list of regexp matches. MATCH-REGEXP
is used to find matches in the region from BEG to END, and USE-REGEXP is the
regexp to place in the match-list variable.
For example, if the region contains the text: {alpha,beta,gamma}
and MATCH-REGEXP is: \\([a-z]+\\),
and USE-REGEXP is: \\1
then match-list will become the list of strings: (\"alpha\" \"beta\")"
(interactive "sMatch regexp: \nsPlace in match-list: \nr")
(setq match-list (make-match-list match-regexp use-regexp beg end))
(reset-match-list-iter))
(defun cycle-match-list (&optional after-end-string)
"Return the next element of match-list.
If AFTER-END-STRING is nil, cycle back to the beginning of match-list.
Else return AFTER-END-STRING once the end of match-list is reached."
(let ((ret-elm (car match-list-iter)))
(unless ret-elm
(if after-end-string
(setq ret-elm after-end-string)
(reset-match-list-iter)
(setq ret-elm (car match-list-iter))))
(setq match-list-iter (cdr match-list-iter))
ret-elm))
(defadvice replace-regexp (before my-advice-replace-regexp activate)
"Advise replace-regexp to support match-list functionality. "
(reset-match-list-iter))
Then to solve the original problem:
M-x set-match-list
Match regexp: \([0-9]+\)[,)]
Place in match-list: \1
M-x replace-regexp
Replace regexp: \([a-z]+\)\([,)]\)
Replace regexp with: \1=\,(cycle-match-list)\2
And to solve the XML example:
[Select fooval strings.]
M-x set-match-list
Match regexp: .+
Place in match-list: \&
[Select XML tags.]
M-x replace-regexp
Replace regexp: foo=""
Replace regexp with: foo="\,(cycle-match-list)"