I am reading the example 3.1Assignment and Local State from SICP
#+begin_src scheme
(define (make-withdraw balance)
(lambda (amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds")))
(define W1 (make-withdraw 100))
(W1 50)
(W1 30)
#+end_src
#+RESULTS:
: 20
Practice with elisp
#+begin_src emacs-lisp lexical t
(defun make-withdraw(balance)
(lambda (amount)
(if (>= balance amount)
(progn (setq balance (- balance amount))
balance)
"Insufficient funds")))
(make-withdraw 10)
(defvar W1 (make-withdraw 100))
(funcall (W1 30))
#+end_src
#+RESULTS:
: W1
Did not work as expected, experiment it interactively
Case 1: call make-withdraw directly and return a closure
;; lexical-binding t
ELISP> (make-withdraw 100)
(closure
((balance . 100)
t)
(amount)
(if
(>= balance amount)
(progn
(setq balance
(- balance amount))
balance)
"Insufficient funds"))
Case 2: Assign it to a W1, yet return a common function rather than a closure
ELISP> (defvar W1 (funcall (withdraw 100)))
W1
ELISP> W1
(lambda
(amount)
(if
(>= balance amount)
(progn
(setq balance
(- balance amount))
balance)
"Insufficient funds"))
How could create an instance W1?
ELISP> (defvar W1 (funcall (withdraw 100)))
withdraw is not make-withdraw -- you've called something else.
ELISP> W1
(lambda ...)
And that something else was not defined with lexical-binding active, otherwise you would be seeing a closure.
As for this...
(make-withdraw 10)
(defvar W1 (make-withdraw 100))
(funcall (W1 30))
You're assigning a function to a variable W1 which means (as you know from your other recent questions here) that you cannot use (W1 30) but would instead have to use (funcall W1 30)
Related
I write the newton-method to find root from Scheme example in elisp as
#+begin_src emacs-lisp :session sicp :lexical t
(defun deriv(g)
(lambda (x)
(/ (- (funcall g (+ x dx)) (funcall g x))
dx)))
(defvar dx 0.00001)
(defvar tolerance 0.00001)
(defun fixed-point(f guess)
(defun close-enoughp(v1 v2)
(< (abs (- v1 v2)) tolerance))
(let ((next (funcall f guess)))
(if (close-enoughp guess next)
next
(fixed-point f next))))
(defun newton-transform(g)
(lambda (x)
(- x (/ (funcall g x) (funcall (funcall #'deriv g) x)))))
(defun newton-method(g guess)
(fixed-point (funcall #'newton-transform g) guess))
(defun curt(x)
(newton-method (lambda (y) (- (* y y y) x))
1.0))
(curt 12)
#+end_src
#+RESULTS:
: 2.2894284851069058
It works but observe the twisted code:
(defun newton-transform(g)
(lambda (x)
(- x (/ (funcall g x) (funcall (funcall #'deriv g) x)))))
Three funcalls, in which I could not imagine bad if more depths of closures.
Is there an alternative solution to the problem with elisp? (I guess it de-appreciates closures)
In newton-transform, (funcall #'deriv g) is identical to (deriv g), so you can eliminate one of the 3 funcalls. The other 2 are, indeed, necessary.
Same for newton-method: replace (funcall #'newton-transform g) with (newton-transform g).
PS. I strongly recommend either moving defun close-enoughp out of defun fixed-point or turning it into a cl-flet. Lisp is not Scheme.
PPS. close-enoughp should be close-enough-p.
A couple of the functions calls can be simplified, and we should implement #sds's advice regarding function names and conventions - like this:
(defvar dx 0.00001)
(defvar tolerance 0.00001)
(defun deriv (g)
(lambda (x)
(/ (- (funcall g (+ x dx)) (funcall g x))
dx)))
(defun close-enough-p (v1 v2)
(< (abs (- v1 v2)) tolerance))
(defun try (f guess)
(let ((next (funcall f guess)))
(if (close-enough-p guess next)
next
(try f next))))
(defun fixed-point (f first-guess)
(try f first-guess))
(defun newton-transform (g)
(lambda (x)
(- x (/ (funcall g x)
(funcall (deriv g) x)))))
(defun newton-method (g guess)
(fixed-point (newton-transform g) guess))
(defun curt (x)
(newton-method (lambda (y) (- (* y y y) x))
1.0))
Notice that we don't need to use funcall when invoking functions previously defined and named, such as deriv and newton-transform.
The code below is the answer given by the professor for a question in my intro to scheme course but it comes out with an error. Cannot see why.
#!r5rs
(define (make-complex a b) (cons a b))
(define (real x) (car x))
(define (imag x) (cdr x))
(define (complex-sqrt x)
(define (sgn v)
(cond ((< v 0) -1)
((= v 0) 0)
(else 1)))
(let ((root (sqrt (+ (* (real x) (real x))
(* (imag x) (imag x))))))
(make-complex (sqrt (/ (+ (real x) root) 2))
(* (sgn (imag x))
(sqrt (/ (- root (real x)) 2))))))
(complex-sqrt 7)
;; ERROR mcar: contract violation
;; expected: mpair?
;; given: 7
I took a screenshot of the error with trace illustartion while running it in DrRacket.
Here's your code transcribed. Please consider posting the actual code rather than a screenshot in future.
(define (make-complex a b) (cons a b))
(define (real x) (car x))
(define (imag x) (cdr x))
(define (complex-sqrt x)
(define (sgn v)
(cond ((< v 0) -1)
((= v 0) 0)
(else 1)))
(let ((root (sqrt (+ (* (real x) (real x))
(* (imag x) (imag x))))))
(make-complex (sqrt (/ (+ (real x) root) 2))
(* (sgn (imag x))
(sqrt (/ (- root (real x)) 2))))))
Was the (complex-sqrt 7) part provided by your professor too? We're trying to get the square root of a complex number, so we should pass in a complex number:
(complex-sqrt (make-complex 5 2))
'(2.27872385417085 . 0.43884211690225433)
Which according to https://www.wolframalpha.com/input/?i=sqrt(2i%2B5) is correct!
The implementation of complex-sqrt is an unsafe one. What that means is that it assumes you pass it a complex number, in this case something created with make-complex.
To fix this you need to check if the argument is complex:
;; Not 100%. Should use `struct` to not
;; mix with random pairs that happens to have numeric parts
(define (complex? x)
(and (pair? x)
(number? (car x))
(number? (cdr x))))
;; The original code is renamed to unsafe-complex-sqrt
(define (complex-sqrt x)
(if (complex? x)
(unsafe-complex-sqrt x)
(raise-argument-error 'complex-sqrt "complex?" x)))
Now you can test it:
(complex-sqrt (make-complex 7 0))
; ==> (2.6457513110645907 . 0)
(complex-sqrt 7)
; ERROR complex-sqrt: contract violation
; expected: complex?
; given: 7
Perfect. Now it says you have mot passed the required complex number to a function that requires a complex number to work.
So what happend in the original code?
In unsafe-complex-sqrt it uses car and cdr which are safe operations that signal contract violation if the argument x supplied isn't #t for (pair? x).
Racket uses mcons in its #!r5rs implementation and thus the errors refer to every pair/list function in R5RS prefixed with an m since the error doesn't pay attention to renaming.
The following Scheme code is about a game with a spaceship and right now it doesn't take into account when the spaceship runs out of fuel, which is what I'm trying to do. Here is the code:
;; this is the code for problem rrset -- Lunar Lander
(define (update ship-state fuel-burn-rate)
(make-ship-state
(+ (height ship-state) (* (velocity ship-state) dt)) ; height
(+ (velocity ship-state)
(* (- (* engine-strength fuel-burn-rate) gravity)
dt)) ; velocity
(cond (<= (fuel 0)
((write-line "no fuel left")
'game-over)
(else
(- (fuel ship-state) (* fuel-burn-rate dt)))))) ; fuel
(define (lander-loop ship-state)
(show-ship-state ship-state)
(if (landed? ship-state)
(end-game ship-state)
(lander-loop (update ship-state (get-burn-rate)))))
(define (show-ship-state ship-state)
(write-line
(list 'height (height ship-state)
'velocity (velocity ship-state)
'fuel (fuel ship-state))))
(define (landed? ship-state)
(<= (height ship-state) 0))
(define (end-game ship-state)
(let ((final-velocity (velocity ship-state)))
(write-line final-velocity)
(cond ((>= final-velocity safe-velocity)
(write-line "good landing")
'game-over)
(else
(write-line "you crashed!")
'game-over))))
(define (get-burn-rate)
(if (= (player-input) burn-key)
1
0))
(define (play) (lander-loop (initial-ship-state)))
(define (initial-ship-state)
(make-ship-state 50 ; 50 km high
0 ; not moving (0 km/sec)
20)) ; 20 kg of fuel left
(define dt 1) ; 1 second interval of simulation
(define gravity 0.5) ; 0.5 km/sec/sec
(define safe-velocity -0.5) ; 0.5 km/sec or faster is a crash
(define engine-strength 1) ; 1 kilonewton-second
(define (player-input)
(char->integer (prompt-for-command-char " action: ")))
(define burn-key 32) ;space key
(define (make-ship-state height velocity fuel)
(list 'HEIGHT height
'VELOCITY velocity
'FUEL fuel))
(define (height state) (second state))
(define (velocity state) (fourth state))
(define (fuel state) (sixth state))
(define (second l) (cadr l))
(define (fourth l) (cadr (cddr l)))
(define (sixth l) (cadr (cddr (cddr l))))
; Users of DrScheme or DrRacket: add these for compatibility with MIT Scheme...
(define (write-line x)
(display x)
(newline))
(define (prompt-for-command-char prompt)
(display prompt)
(read-char))
To modify it, I modified the "update" procedure, so now there is a conditional statement:
(define (update ship-state fuel-burn-rate)
(make-ship-state
(+ (height ship-state) (* (velocity ship-state) dt)) ; height
(+ (velocity ship-state)
(* (- (* engine-strength fuel-burn-rate) gravity)
dt)) ; velocity
(cond (<= (fuel 0)
((write-line "no fuel left")
'game-over)
(else
(- (fuel ship-state) (* fuel-burn-rate dt))))))
however this doesn't work.
You're going to want to add your conditional to the lander-loop procedure. This is the part of the code that checks whether the game is over each cycle.
(define (lander-loop ship-state)
(show-ship-state ship-state)
(if (or (landed? ship-state) (<= (fuel ship-state) 0))
(end-game ship-state)
(lander-loop (update ship-state (get-burn-rate)))))
Then you can add your out of fuel message to the end-game procedure.
I found code for generating Sierpinski carpet at http://rosettacode.org/wiki/Sierpinski_carpet#Scheme - but it won't run in the DrRacket environment or WeScheme. Could someone provide solutions for either environments?
It looks like this code runs fine in DrRacket after prepending a
#lang racket
line indicating that the code is written in Racket. I can provide more detail if this is not sufficient.
I've translated the program to run under WeScheme. I've made a few changes: rather than use (display) and (newline), I use the image primitives that WeScheme provides to make a slightly nicer picture. You can view the running program and its source code. For convenience, I also include the source here:
;; Sierpenski carpet.
;; http://rosettacode.org/wiki/Sierpinski_carpet#Scheme
(define SQUARE (square 10 "solid" "red"))
(define SPACE (square 10 "solid" "white"))
(define (carpet n)
(local [(define (in-carpet? x y)
(cond ((or (zero? x) (zero? y))
#t)
((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
#f)
(else
(in-carpet? (quotient x 3) (quotient y 3)))))]
(letrec ([outer (lambda (i)
(cond
[(< i (expt 3 n))
(local ([define a-row
(letrec ([inner
(lambda (j)
(cond [(< j (expt 3 n))
(cons (if (in-carpet? i j)
SQUARE
SPACE)
(inner (add1 j)))]
[else
empty]))])
(inner 0))])
(cons (apply beside a-row)
(outer (add1 i))))]
[else
empty]))])
(apply above (outer 0)))))
(carpet 3)
Here is the modified code for WeScheme. WeScheme don't support do-loop syntax, so I use unfold from srfi-1 instead
(define (unfold p f g seed)
(if (p seed) '()
(cons (f seed)
(unfold p f g (g seed)))))
(define (1- n) (- n 1))
(define (carpet n)
(letrec ((in-carpet?
(lambda (x y)
(cond ((or (zero? x) (zero? y))
#t)
((and (= 1 (remainder x 3)) (= 1 (remainder y 3)))
#f)
(else
(in-carpet? (quotient x 3) (quotient y 3)))))))
(let ((result
(unfold negative?
(lambda (i)
(unfold negative?
(lambda (j) (in-carpet? i j))
1-
(1- (expt 3 n))))
1-
(1- (expt 3 n)))))
(for-each (lambda (line)
(begin
(for-each (lambda (char) (display (if char #\# #\space))) line)
(newline)))
result))))
It's difficult to tell what is being asked here. This question is ambiguous, vague, incomplete, overly broad, or rhetorical and cannot be reasonably answered in its current form. For help clarifying this question so that it can be reopened, visit the help center.
Closed 10 years ago.
Example input:
((a1 . b) (a1 . c)):
I have one list with two elements, those elements are lists or pairs with two elements. And i want to check if the first element of the first pair/list is equal to the first element of the second pair/list.
output: If so, i want to create a new list with two lists, the first is the list:
while (b < c) -> (a1 . b(even)) (a1 . b+2(even))...
The other list is the same, but with the odd's
How do I implement this in scheme:
INPUT:
((1 . 1) (1 . 7))
OUTPUT:
(((1 . 2) (1 . 4) (1 . 6)) ((1 . 3) (1 . 5) (1 . 7)))
I have one list with two elements. Each element is also a list with two elements, both integers >= 0 and < 8
I have to create this:
input ((a1 . b) (a1 . c))
output: (if (and (= a1 a2) (odd? b))
While < b c
(list (a1 . b+1) (a1 . b+3) (a1 . b+n)...))
(list (a2 . b) (a2 . b+2) (a2 . b+4)...)
I had done this, but i can't find where i'm failing, could you help me?....
;;; Verify if absissa0 = absissa1
(define (game-position input)
(if (= (car (car j)) (cdr (cdr j)))
(col1_col2 j)
(error "Not valid"))))
;;; verify if absissa0 is even
(define (col1_col2 gstart)
(if (even? (cdr (car jstart)))
(list (pos-start jstart))
(list (pos-start (list (cons (car (car jstart)) (- (cdr (car jstart)) 1)) (car (cdr jstart))))))
;;; Loop that creates positions of even's and odd's
(define (pos-start j2)
(while ( < (cdr (car j2)) (- (cdr (cdr j2)) 2))
((cons (car (car j2)) (+ (cdr (car j2)) 2)) (pos-start (list (cons (car (car j2)) (+ (cdr (car j2)) 2)) (car (cdr j2)))))
(odd_2 (list (cons (car (car j2)) (+ (cdr (car j2)) 1)) (car (cdr j2)))))
(define (odd_2 j3)
(while ( < (cdr (car j3)) (- (car (cdr j3)) 2))
((j3) (odd_2 (list (cons (car (car j3)) (+ (cdr (car j3)) 2)) (car (cdr j3)))
(value)))
; position l e a coluna c.
(define (do-pos l c)
(if (and (integer? l) (integer? c) (>= l 0) (>= c 0) (<= l 7) (<= c 7))
(cons l c)
(error "insert a valid number between 0 and 7")))
; returns l
(define (line-pos p)
(car p))
; returns c
(define (column-pos p)
(cdr p))
; Arg is position.
(define (pos? arg)
(and (pair? arg) (integer? (line-pos arg)) (integer? (column-pos arg)) (< (car arg) 8) (>= (car arg) 0) (< (cdr arg) 8) (>= (cdr arg) 0)))
; two positions are equal?
(define (pos=? p1 p2)
(and (= (line-pos p1)(line-pos p2))(= (column-pos p1)(column-pos p2))))
(define (oper* x y)
(* (- x y) (- x y)))
; Distance between p1 e p2.
(define (distance p1 p2)
(sqrt (+ (oper* (line-pos p1) (line-pos p2)) (oper* (column-pos p1) (column-pos p2)))))
; Same directions? if same line and same column
(define (same-direction? p1 p2)
(or (= (line-pos p1) (line-pos p2)) (= (column-pos p1) (column-pos p2))))
; check if to positions are adjacent
(define (adjacent? p1 p2)
(and (same-direccao? p1 p2) (= (distance p1 p2) 1)))
; from a position, returns all adjacents moves
(define (adjacent p) (cond ((and (= (line-pos p) 0) (= (column-pos p) 0)) (list (faz-pos (+ (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (+ (column-pos p) 1))))
((and (= (line-pos p) 7) (= (column-pos p) 7)) (list (do-pos (- (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (- (column-pos p) 1))))
((= (line-pos p) 0) (list (do-pos (+ (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (+ (column-pos p) 1)) (do-pos (line-pos p) (- (column-pos p) 1))))
((= (column-pos p) 0) (list (do-pos (+ (line-pos p) 1) (column-pos p)) (do-pos (- (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (+ (column-pos p) 1))))
((= (line-pos p) 7) (list (do-pos (- (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (+ (column-pos p) 1)) (do-pos (line-pos p) (- (column-pos p) 1))))
((= (column-pos p) 7) (list (do-pos (+ (line-pos p) 1) (column-pos p)) (do-pos (- (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (- (column-pos p) 1))))
(else (list (do-pos (+ (line-pos p) 1) (column-pos p)) (do-pos (- (line-pos p) 1) (column-pos p)) (do-pos (line-pos p) (+ (column-pos p) 1)) (do-pos (line-pos p) (- (column-pos p) 1))))))
; returns a move with p1 and p2
(define (do-game p1 p2)
(if (and (pos? p1) (pos? p2))
(list p1 p2)
(error "Insert two valid positions")))
; returns the beguining of j.
(define (b-do-game j)
(car j))
; returns the end of j.
(define (e-do-hame j)
(car (cdr j)))
; Arg is a do-game?.
(define (do-game? arg)
(and (list? arg) (pos? (b-do-game arg)) (pos? (e-do-game arg))))
; do game is null?.
(define (do-game-null? j)
(pos=? (b-do-game j) (e-do-game j)))
; list with two do-game (pc and pl)
(define (play-pos pc pl)
(if (and (list? pc) (list? pl))
(list pc pl)
(error "Insere two valid moves")))
; returns pc.
(define (cap-pieces pj)
(b-do-game pj))
; returns pj
(define (free_pieces pj)
(e-do-game pj))
(define (neven n)
(if (even? n)
n (+ n 1)))
; create sublists
(define (sublist a mn mx)
(cond ((<= mn mx) (cons (do-pos a mn) (sublist a (+ mn 2) mx)))
(else '())))
(define (sublist2 a mn mx)
(cond ((<= mx (- mn 2)) (cons (do-pos a (- mn 2)) (sublist2 a (- mn 2) mx)))
(else '())))
(define (sublist3 a mn mx)
(cond ((<= mn mx) (cons (do-pos mn a) (sublist3 a (+ mn 2) mx)))
(else '())))
(define (sublist4 a mn mx)
(cond ((<= mx (- mn 2)) (cons (do-pos (- mn 2) a) (sublist4 a (- mn 2) mx)))
(else '())))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Returns game-positions
(define (game-positions j)
(if (not (and (do-game? j) (same-direction? (b-do-game j) (e-do-game j)) (even? (distance (b-do-game j) (e-do-game j)))))
(list)
(if (= (line-pos (b-do-game j)) (line-pos (e-do-game j)))
(f_odd_even? j)
(f_odd_even2? j))))
; Check is starts with odd or even.
(define (f_odd_even? j) (if (even? (column-pos (b-do-game j)))
(b_even j)
(b_odd j)))
(define (f_odd_even2? j) (if (even? (line-pos (b-do-jogada j)))
(b-even1 j)
(b_odd1 j)))
; If starts with odd:
(define (b_odd j)
(if (< (column-pos (b-do-game j)) (column-pos (e-do-game j)))
(list (sublist (line-pos (b-do-game j))
(neven (column-pos (b-do-game j)))
(column-pos (e-do-game j)))
(sublist (line-pos (b-do-game j))
(+ 1 (neven (column-pos (b-do-game j))))
(column-pos (e-do-game j))))
(list (sublist2 (line-pos (b-do-game j))
(+ 1 (column-pos (b-do-game j)))
(column-pos (e-do-game j)))
(sublist2 (line-pos (b-do-game j))
(column-pos (b-do-game j))
(- 1 (column-pos (e-do-game j)))))))
(define (b_even j)
(if (< (column-pos (b-do-game j)) (column-pos (e-do-game j)))
(list (sublist (line-pos (b-do-game j))
(+ 2 (neven (column-pos (b-do-game j))))
(column-pos (e-do-game j)))
(sublist (line-pos (b-do-game j))
(+ 1 (neven (column-pos (b-do-game j))))
(column-pos (e-do-game j))))
(list (sublist2 (line-pos (b-do-game j))
(column-pos (b-do-game j))
(column-pos (e-do-game j)))
(sublist2 (line-pos (b-do-game j))
(+ 1 (column-pos (b-do-game j)))
(column-pos (e-do-game j))))))
(define (b_odd1 j)
(if (< (line-pos (b-do-game j)) (column-pos (e-do-game j)))
(list (sublist3 (column-pos (b-do-game j))
(neven (line-pos (b-do-game j)))
(line-pos (e-do-game j)))
(sublist3 (column-pos (b-do-game j))
(+ 1 (neven (line-pos (b-do-game j))))
(line-pos (e-do-game j))))
(list (sublist4 (column-pos (b-do-game j))
(+ 1 (line-pos (b-do-game j)))
(line-pos (e-do-game j)))
(sublist4 (column-pos (b-do-game j))
(line-pos (b-do-game j))
(- 1 (line-pos (e-do-game j)))))))
(define (b_even1 j)
(if (< (line-pos (b-do-game j)) (line-pos (e-do-game j)))
(list (sublist3 (column-pos (b-do-game j))
(+ 2 (neven (line-pos (b-do-game j))))
(line-pos (e-do-game j)))
(sublist3 (column-pos (b-do-game j))
(+ 1 (neven (line-pos (b-do-game j))))
(line-pos (e-do-game j))))
(list (sublist4 (column-pos (b-do-game j))
(line-pos (b-do-game j))
(line-pos (e-do-game j)))
(sublist4 (column-pos (b-do-game j))
(+ 1 (line-pos (b-do-game j)))
(line-pos (e-do-game j))))))
This is the first part of the game I'm making, I was translating the variables from portuguese to english so it could have some error.
Dlm, can you do the same that you did in your code with "while cicles"?
Could you check my code and improve it a litle? I am trying to improve my programming skills, and it's starts from my code, Basicaly I want to get a programming style
Sorry for the previous posting. It was my first post
and I posted as an unregistered user. I obviously
haven't figured out how to format text yet.
I've created an account (user dlm) and I'm making a
second attempt -- here goes.
I've been working on learning Racket/Scheme for a while
now and this site looks like a great place to share and
learn from others.
I'm not 100% sure of the spec on this question and
have my doubts that my code actually solves the problem
at hand but I think it's readable enough to be modified
as needed
Readability is one of the things I've been working on
and would appreciate feedback/suggestions from others.
dlm.
My 2 cents :
(define (process-list? lst)
(let*([pair-0 (list-ref lst 0)]
[pair-1 (list-ref lst 1)])
(and (= (car pair-0) (car pair-1))
(< (cdr pair-0) (cdr pair-1)))))
(define (make-odd/even-sets data)
(let*([x (car (list-ref data 0))]
[y-start (cdr (list-ref data 0))]
[max (cdr (list-ref data 1))])
(define (loop y evens odds)
(if (<= y max)
(loop (add1 y)
(if (even? y) (cons (cons x y) evens) evens)
(if (odd? y) (cons (cons x y) odds) odds))
(list (reverse odds) (reverse evens))))
(loop y-start '() '())))
(define (main data)
(if (process-list? data)
(let*([odd/even (make-odd/even-sets data)])
(printf "~a~n" (list-ref odd/even 0))
(printf "~a~n" (list-ref odd/even 1)))
(printf "Invalid list~n" )))
(main '((1 . 1) (1 . 7)) )
UPDATE:
Hi gn66,
I don't know how much I can actually do in terms of the
game itself but I might be able to give you some
pointers/ideas.
A major thing to look for in improving code is to to
look for repeating code applied to specific situations
and try to think of ways to generalize. At first the
generalized form can seam harder to read when you don't
see what's going on but once you fully understand it
it's actually easier, not only to read but modify.
Looking at your code the 'adjacent' procedure jumps out
as something that could be shortened so I'll use that as
an example. Let's start by first ignoring the boundary
conditions and look for the generial pattern of
operations (example: where you put the logic for
conditional test can have a big effect on the size of the
code).
(define (adjacent p)
(list (do-pos (+ (line-pos p) 1) (column-pos p))
(do-pos (- (line-pos p) 1) (column-pos p))
(do-pos (line-pos p) (+ (column-pos p) 1))
(do-pos (line-pos p) (- (column-pos p) 1))) )
The problem here can be partitioned into 2 different
problems: 1) changing line postions + - 1 and
2) changing row positions + - 1. Both applying
the same operations to different components of the
position. So let's just work with one.
(instead of a while loop lets look at MAP which is
like a "while list not empty" loop)
Using 'map' to apply an operation to data list(s)
is pretty straight forward:
(map (lambda (val) (+ val 5))
'(10 20 30))
If needed you can inclose it inside the scope of a procdure
to maintain state information such as a counter:
(define (test lst)
(let*([i 0])
(map (lambda (val)
(set! i (+ i 1))
(+ val i))
lst)))
(test '(10 20 30))
Or pass in values to use in the operation:
(define (test lst amount)
(map (lambda (val) (+ val amount))
lst))
(test '(10 20 30) 100)
Now turn your thinking inside out and consider that
it's possible to have it map a list of operations to
some data rather than data to the operation.
(define (test val operations-lst)
(map (lambda (operation) (operation val))
operations-lst))
(test 10 (list sub1 add1))
Now we have the tools to start creating a new
'adjacent' procedure:
(define (adjacent p)
(define (up/down p) ;; operations applied to the line componet
(map (lambda (operation)
(cons (operation (line-pos p)) (column-pos p)))
(list add1 sub1)))
(define (left/right p) ;; operations applied to the column componet
(map (lambda (operation)
(cons (line-pos p) (operation (column-pos p))))
(list add1 sub1)))
(append (up/down p) (left/right p))
)
(adjacent (do-pos 1 1))
This works find for positions that aren't on the boundary
but just as the old saying goes "it's sometimes easier to do
something and then apologize for it than it is to first ask
permission". Let's take the same approach and let the errant
situations occur then remove them. The 'filter' command is
just the tool for the job.
The 'filter' command is similiar to the map command in that
it takes a list of values and passes them to a function. The
'map' command returns a new list containing new elements
that correpsond to each element consumed. Filter returns
the original values but only the ones that the (predicate)
function "approves of" (returns true for).
(filter
(lambda (val) (even? val))
'(1 2 3 4 5 6 7 8))
will return the list (2 4 6 8)
So adding this to the new 'adjacent' procedure we get:
(define (adjacent p)
(define (up/down p)
(map (lambda (operation)
(cons (operation (line-pos p)) (column-pos p)))
(list add1 sub1)))
(define (left/right p)
(map (lambda (operation)
(cons (line-pos p) (operation (column-pos p))))
(list add1 sub1)))
(define (select-valid p-lst)
(filter
(lambda (p) (and (>= (line-pos p) 0) (>= (column-pos p) 0)
(<= (line-pos p) 7) (<= (column-pos p) 7)))
p-lst))
(select-valid
(append (up/down p) (left/right p))))
As for the "while cycles" you asked about: you need to
develop the ability to "extract" information like this from
existing examples. You can explore different aspects of
existing code by trying to remove as much code as you can
and still get it to work for what you are interested in
(using print statements to get a window onto what's going
on). This is a great way to learn.
From my first posting cut out the loop that creates the
evens/odds list. When you try to run you find out what is
missing (the dependencies) from the error messages so
just define them as needed:
(define x 1)
(define max 5)
(define (loop y evens odds)
(if (<= y max)
(loop (add1 y)
(if (even? y) (cons (cons x y) evens) evens)
(if (odd? y) (cons (cons x y) odds) odds))
(list (reverse odds) (reverse evens))))
(loop 1 '() '())
Add a print statement to get info on the mechanics of how
it works:
(define x 1)
(define max 5)
(define y-start 1)
(define (loop y evens odds)
(if (<= y max)
(begin
(printf "section 1 : y=~a~n" y)
(loop (add1 y)
(if (even? y) (cons (cons x y) evens) evens)
(if (odd? y) (cons (cons x y) odds) odds)))
(begin
(printf "section 2 : y=~a~n" y)
(list (reverse odds) (reverse evens))
)))
(loop y-start '() '())
Now remove parts you aren't interested in or don't need,
which may take some exploration:
(let*([max 5])
(define (loop y)
(if (<= y max)
(begin
(printf "section 1 : y=~a~n" y)
(loop (add1 y)))
(begin
(printf "section 2 : y=~a~n" y)
'()
)))
(loop 1))
Now you should be able to more easily see the mechanics of a
recursive while loop and use this as a simple template
to apply to other situations.
I hope this helps and I hope it doesn't cross the line
on the "subjective questions" guidelines -- I'm new to
this site and hope to fit in as it looks like a great
resource.
I'm a bit rusty in scheme, I've managed to get this solution to your problem,
it use recursion vs while, but I'm not accustomed to that construct in scheme:
(define data (list (cons 1 1) (cons 1 7)))
(define (neven n) (if (even? n) n (+ n 1)))
(define (sublist a mn mx)
(cond
((<= mn mx ) (cons (cons a mn) (sublist a (+ mn 2) mx)))
(else '())))
(define (game-position input)
(if (= (caar input) (caadr input))
(list (sublist (caar input)
(neven (cdar input))
(cdadr input))
(sublist (caar input)
(+ 1 (neven (cdar input)))
(cdadr input)))
(error "no match")))
(game-position data)
edit: It works in guile and drscheme. Hope it will works in plt-scheme too.
edit: sublist inner working
First the parameters:
a is the car of the pairs contained into the list
mn is the cdr of the first pair
mx is the upper limit of the serie.
the body of the function is quite simple:
if the cdr of the current pair is smaller or equal to the upper limit then return a list
composed by a pair (a . mn) and the list created by a call to sublist with the mn parameter changed to reflect the next possible pair.
if the current pair will have a cdr higher than the upper limit then return null (empty list) in order to close the cons issued by the previous invocation of sublist.
I've been working on learning Racket/Scheme for a while
now and this site looks like a great place to share and
learn from others.
I'm not 100% sure of the spec on this question and
have my doubts that my code actually solves the problem
at hand but I think it's readable enough to be modified
as needed
Readability is one of the things I've been working on
and would appreciate feedback/suggestions from others.
dlm.
My 2 cents :
(define (process-list? lst)
(let*([pair-0 (list-ref lst 0)]
[pair-1 (list-ref lst 1)])
(and (= (car pair-0) (car pair-1))
(< (cdr pair-0) (cdr pair-1)))))
(define (make-odd/even-sets data)
(let*([x (car (list-ref data 0))]
[y-start (cdr (list-ref data 0))]
[max (cdr (list-ref data 1))])
(define (loop y evens odds)
(if (<= y max)
(loop (add1 y)
(if (even? y) (cons (cons x y) evens) evens)
(if (odd? y) (cons (cons x y) odds) odds))
(list (reverse odds) (reverse evens))))
(loop y-start '() '())))
(define (main data)
(if (process-list? data)
(let*([odd/even (make-odd/even-sets data)])
(printf "~a~n" (list-ref odd/even 0))
(printf "~a~n" (list-ref odd/even 1)))
(printf "Invalid list~n" )))
(main '((1 . 1) (1 . 7)) )