How do I divide these lists? [closed] - scheme

Question

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)))

Answer 1

; 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

Answer 2

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.

Answer 3

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.

Answer 4

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)) )