Repeat the string list in Scheme language - scheme

I'm trying to make a code with Scheme language.I want to input a list and return the string representation of the list where the first element is repeated one time, the second element repeats two times and third element repeats three times like
input is => (c d g)
output is => (c d d g g g)
I wrote a code with duplicating all elements. I should use loop for making repeat all elements from first one to last one with 1 to n times.(n is size of list). But I do not know how.
(define repeat
(lambda (d)
(cond [(null? d) '()]
[(not (pair? (car d)))
(cons (car d)
(cons (car d)
(repeat (cdr d))))]
[else (cons (repeat (car d))
(repeat (cdr d)))])))
(repeat '(a b c d e)) => aa bb cc dd ee
(define size
(lambda (n)
(if (null? n)
0
(+ 1 (size (cdr n))))))
(size '(A B C D)) => 4

You will need to make a few different functions for this.
repeat (as you described) acts like this (repeat '(c d g)) ;=> (c d d g g g)
The best way to implement that is using a helper (repeat-aux n lst) which repeats the first element n times, the second element n+1 times and so on.
Given that you can define:
(define (repeat lst) (repeat-aux 1 lst))
To implement repeat-aux you can use a recursion pattern like this
(define (repeat-aux n lst)
(if (null? lst)
'()
... (repeat-aux (+ n 1) (cdr lst) ...))
I'm just giving a sketch or outline of the function, not the whole thing. So that you can work on it yourself.
To implement repeat-aux I would also recommend making a helping function (replicate n elt tail) which works like this:
(replicate 3 'o '(u v w)) ;=> (o o o u v w)
I hope the idea of breaking it down into simple helper function makes it easier. Have a go and feel free to ask if you get stuck.

Related

how to get N first element of a list

I want to make a function to get the N-th first element of a list.
For example :
>>(firsts 3 '(a b c d e))
return : (a b c)
I made that :
(define (firsts number lst)
(let ((maliste '()))
(if (equal? 0 number)
maliste
(and (set! maliste (cons (car lst) maliste)) (firsts (- number 1) (cdr lst))))))
But it doesn't work, I think I should use a let but I don't know how.
Thanks .
It's a lot simpler, remember - you should try to think functionally. In Lisp, using set! (or other operations that mutate state) is discouraged, a recursive solution is the natural approach. Assuming that the list has enough elements, this should work:
(define (firsts number lst)
; as an exercise: add an extra condition for handling the
; case when the list is empty before the number is zero
(if (equal? 0 number)
'()
(cons (car lst)
(firsts (- number 1) (cdr lst)))))

Getting every nth atom using scheme does not pick up the last atom

The program is suppose to pick out every third atom in a list.
Notice that the last atom 'p' should be picked up, but its not.
Any suggestions as to why the last atom is not being selected.
(define (every3rd lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (car lst)
(every3rd (cdr(cdr(cdr lst)))))))
(every3rd '(a b c d e f g h i j k l m n o p))
Value 1: (a d g j m)
Thanks
You're missing a couple of base cases:
(define (every3rd lst)
(cond ((or (null? lst) (null? (cdr lst))) lst)
((null? (cdr (cdr lst))) (list (car lst)))
(else (cons (car lst)
(every3rd (cdr (cdr (cdr lst))))))))
See how the following cases should be handled:
(every3rd '())
=> '()
(every3rd '(a))
=> '(a)
(every3rd '(a b))
=> '(a)
(every3rd '(a b c))
=> '(a)
(every3rd '(a b c d))
=> '(a d)
(every3rd '(a b c d e f g h i j k l m n o p))
=> '(a d g j m p)
Fixing your code (covering the base cases)
It's worth noting that Scheme defines a number of c[ad]+r functions, so you can use (cdddr list) instead of (cdr (cdr (cdr list))):
(cdddr '(a b c d e f g h i))
;=> (d e f g h i)
Your code, as others have already pointed out, has the problem that it doesn't consider all of the base cases. As I see it, you have two base cases, and the second has two sub-cases:
if the list is empty, there are no elements to take at all, so you can only return the empty list.
if the list is non-empty, then there's at least one element to take, and you need to take it. However, when you recurse, there are two possibilies:
there are enough elements (three or more) and you can take the cdddr of the list; or
there are not enough elements, and the element that you took should be the last.
If you assume that <???> can somehow handle both of the subcases, then you can have this general structure:
(define (every3rd list)
(if (null? list)
'()
(cons (car list) <???>)))
Since you already know how to handle the empty list case, I think that a useful approach here is to blur the distinction between the two subcases, and simply say: "recurse on x where x is the cdddr of the list if it has one, and the empty list if it doesn't." It's easy enough to write a function maybe-cdddr that returns "the cdddr of a list if it has one, and the empty list if it doesn't":
(define (maybe-cdddr list)
(if (or (null? list)
(null? (cdr list))
(null? (cddr list)))
'()
(cdddr list)))
> (maybe-cdddr '(a b c d))
(d)
> (maybe-cdddr '(a b c))
()
> (maybe-cdddr '(a b))
()
> (maybe-cdddr '(a))
()
> (maybe-cdddr '())
()
Now you can combine these to get:
(define (every3rd list)
(if (null? list)
'()
(cons (car list) (every3rd (maybe-cdddr list)))))
> (every3rd '(a b c d e f g h i j k l m n o p))
(a d g j m)
A more modular approach
It's often easier to solve the more general problem first. In this case, that's taking each nth element from a list:
(define (take-each-nth list n)
;; Iterate down the list, accumulating elements
;; anytime that i=0. In general, each
;; step decrements i by 1, but when i=0, i
;; is reset to n-1.
(let recur ((list list) (i 0))
(cond ((null? list) '())
((zero? i) (cons (car list) (recur (cdr list) (- n 1))))
(else (recur (cdr list) (- i 1))))))
> (take-each-nth '(a b c d e f g h i j k l m n o p) 2)
(a c e g i k m o)
> (take-each-nth '(a b c d e f g h i j k l m n o p) 5)
(a f k p)
Once you've done that, it's easy to define the more particular case:
(define (every3rd list)
(take-each-nth list 3))
> (every3rd '(a b c d e f g h i j k l m n o p))
(a d g j m)
This has the advantage that you can now more easily improve the general case and maintain the same interface every3rd without having to make any changes. For instance, the implementation of take-each-nth uses some stack space in the recursive, but non-tail call in the second case. By using an accumulator, we can built the result list in reverse order, and return it when we reach the end of the list:
(define (take-each-nth list n)
;; This loop is like the one above, but uses an accumulator
;; to make all the recursive calls in tail position. When
;; i=0, a new element is added to results, and i is reset to
;; n-1. If i≠0, then i is decremented and nothing is added
;; to the results. When the list is finally empty, the
;; results are returned in reverse order.
(let recur ((list list) (i 0) (results '()))
(cond ((null? list) (reverse results))
((zero? i) (recur (cdr list) (- n 1) (cons (car list) results)))
(else (recur (cdr list) (- i 1) results)))))
It is because (null? '()) is true. you can debug what's happening with following code
(define (every3rd lst)
(if (begin
(display lst)
(newline)
(or (null? lst)
(null? (cdr lst))))
'()
(cons (car lst)
(every3rd (cdr(cdr(cdr lst)))))))
(every3rd '(a b c d e f g h i j k l m n o p))
(newline)
(display (cdr '(p)))
(newline)
(display (null? '()))
(newline)
(display (null? (cdr '(p))))
(newline)
this gives following result.
(a b c d e f g h i j k l m n o p)
(d e f g h i j k l m n o p)
(g h i j k l m n o p)
(j k l m n o p)
(m n o p)
(p)
()
#t
#t

Scheme collecting similar items in a list and finding most common item in a list [duplicate]

This question already has answers here:
Count occurrence of element in a list in Scheme?
(4 answers)
Closed 8 years ago.
I want to make a function that occurs how many times an element occurs in a list. For example in the list: '(a b c b b c c a) I want it to return a nested list with:
'((a 2) (b 3) (c 3))
I know the function will look sort of like this:
(define collect-similar
(lambda (elm ls)
(cond
[(null? ls) '()]
[(equal? elm (car ls))]
I know that I need to continue checking through the list until it arrives back at the base case of the null list and I can check the rest of the list by using cadr. But I'm not too sure on how to get the value and how to make it return the nested list.
The next function I'm trying to write finds the most common element in the list. For example running the function on the list '(a a a a a b c) will simply return a. I know I can make use of the collect-similar function and find which number is the highest.
This has been asked before, just adapt one of #ChrisJester-Young's bagify implementations. For example:
(define (collect-similar lst) ; a slightly modified `bagify`
(hash->list
(foldl (lambda (key ht)
(hash-update ht key add1 0))
'#hash()
lst)))
(collect-similar '(a b c b b c c a))
=> '((a . 2) (b . 3) (c . 3))
With collect-similar in place, it's simple to find the most common element:
(define (most-common lst)
(let loop ((alst (collect-similar lst)) ; use previous procedure
(maxv '(#f . -inf.0)))
(cond ((null? alst) (car maxv))
((> (cdar alst) (cdr maxv))
(loop (cdr alst) (car alst)))
(else
(loop (cdr alst) maxv)))))
(most-common '(a a a a a b c))
=> 'a

Looking for an algorithm to rearrange a list

I've been trying to figure out an algorithm that will do the following:
The algorithm will be handed a list like this:
((start a b c) (d e f (start g h i) (j k l) (end)) (end) (m n o))
It will then concatenate the list containing the element start with all lists up to the list containing the element end. The list returned then should look like this:
((start a b c (d e f (start g h i (j k l)))) (m n o))
The algorithm must be able to handle lists containing start within other lists containing start.
Edit:
What I have now is this:
(defun conc-lists (l)
(cond
((endp l) '())
((eq (first (first l)) 'start)
(cons (cons (first (first l)) (conc-lists (rest (first l)))))
(conc-lists (rest l)))
((eq (first (first l)) 'end) '())
(t (cons (first l) (conc-lists (rest l))))))
but it's not working. Maybe I should list or append instead of consing?
Edit 2:
The program above shouldn't work since I'm trying to get the first element from a non-list. This is what I have come up with so far:
(defun conc-lists (l)
(cond
((endp l) '())
((eq (first (first l)) 'start)
(append (cons (first (first l)) (rest (first l)))
(conc-lists (rest l))))
((eq (first (first l)) 'end) '())
(t (cons (first l) (conc-lists (rest l))))))
This is the result I'm getting:
(conc-lists ((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
1. Trace: (CONC-LISTS '((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
2. Trace: (CONC-LISTS '((D E F (START G H I) (J K L) (END)) (END) (M N O)))
3. Trace: (CONC-LISTS '((END) (M N O)))
3. Trace: CONC-LISTS ==> NIL
2. Trace: CONC-LISTS ==> ((D E F (START G H I) (J K L) (END)))
1. Trace: CONC-LISTS ==> (START A B C (D E F (START G H I) (J K L) (END)))
(START A B C (D E F (START G H I) (J K L) (END)))
I'm also a relative beginner to CL, but this seemed like an interesting challenge, so I had a go at it. Experienced lispers, comments please on this code! #user1176517, if you find any bugs, let me know!
A couple comments first: I wanted to make it O(n), not O(n^2), so I made the recursive functions return both the head and tail (i.e. last cons) of the lists resulting from recursively processing the branches of the tree. This way, in conc-lists-start, I can nconc the last cons of one list onto the first cons of another, without nconc having to walk down a list. I used multiple return values to do this, which unfortunately bloats the code a fair bit. In order to make sure that tail is the last cons of the resulting list, I need to check whether the cdr is null before recurring.
There are two recursive functions which process the tree: conc-lists and conc-lists-first. When conc-lists sees a (start), recursive processing continues with conc-lists-start. Likewise, when conc-lists-start sees an (end), recursive processing continues with conc-lists.
I'm sure it could use more comments... I may add more later.
Here's the working code:
;;; conc-lists
;;; runs recursively over a tree, looking for lists which begin with 'start
;;; such lists will be nconc'd with following lists a same level of nesting,
;;; up until the first list which begins with 'end
;;; lists which are nconc'd onto the (start) list are first recursively processed
;;; to look for more (start)s
;;; returns 2 values: head *and* tail of resulting list
;;; DESTRUCTIVELY MODIFIES ARGUMENT!
(defun conc-lists (lst)
(cond
((or (null lst) (atom lst)) (values lst lst))
((null (cdr lst)) (let ((head (conc-process-rest lst)))
(values head head)))
(t (conc-process-rest lst))))
;;; helper to factor out repeated code
(defun conc-process-rest (lst)
(if (is-start (car lst))
(conc-lists-start (cdar lst) (cdr lst))
(multiple-value-bind (head tail) (conc-lists (cdr lst))
(values (cons (conc-lists (car lst)) head) tail))))
;;; conc-lists-start
;;; we have already seen a (start), and are nconc'ing lists together
;;; takes *2* arguments so that 'start can easily be stripped from the
;;; arguments to the initial call to conc-lists-start
;;; recursive calls don't need to strip anything off, so the car and cdr
;;; are just passed directly
(defun conc-lists-start (first rest)
(multiple-value-bind (head tail) (conc-lists first)
(cond
((null rest) (let ((c (list head))) (values c c)))
((is-end (car rest))
(multiple-value-bind (head2 tail2) (conc-lists (cdr rest))
(values (cons head head2) tail2)))
(t (multiple-value-bind (head2 tail2) (conc-lists-start (car rest) (cdr rest))
(nconc tail (car head2))
(values (cons head (cdr head2)) tail2))))))
(defun is-start (first)
(and (listp first) (eq 'start (car first))))
(defun is-end (first)
(and (listp first) (eq 'end (car first))))

Operating on Nested Lists

I have a nested list structure of arbitrary length, with a depth of three. The first level has arbitrary length, as does the second level, but the third level is guaranteed to have a uniform length across the whole thing. An example of said structure would be '(((A B) (C D)) ((E F) (G H)) ((I J))).
I'm trying to write a function that would apply another function across the different levels of the structure (sorry, I don't really know how to phrase that). An example of the function mapping across the example structure would be in this order:
f A C = AC, f B D = BD, f E G = EG, f F H = FH, f I = I, f J = J,
yielding
'((AC BD) (EG FH) (I J))
but imagining that the third level of the list contains many more elements (say, around 32,000 in the final version).
Essentially, what I'm trying to do would be expressed in Haskell as something like f . transpose. I know I need something like (map car (map flatten (car ...))) to get the first part of the first section, but after that, I'm really lost with the logic here. I'm sorry if this is a really convoluted, poorly explained question. I'm just really lost.
How would I go about applying the function across the structure in this manner?
(define l '(((A B)
(C D))
((E F)
(G H))
((I J)))
)
(define zip (lambda lists (apply map list lists)))
(define (f values) (list 'f values))
(map (lambda (v) (map (lambda values (apply f values)) (apply zip v))) l)
prints
(((f (a c)) (f (b d))) ((f (e g)) (f (f h))) ((f (i)) (f (j))))
It would be much easier to define your f as a function that takes in a list of values. If not, then the last form is easy to add apply to, but it doesn't make it better. (Using a rest argument means that the language will have to create these lists anyway.)
#lang racket
(define data '(((A B) (C D)) ((E F) (G H)) ((I J))))
(define (f xs) (string->symbol (string-append* (map symbol->string xs))))
(map (λ (pairs)
(list (f (map first pairs))
(f (map second pairs))))
data)
(map (λ (pairs) (map f (apply map list pairs)))
data)
(for/list ([pairs (in-list data)])
(for/list ([xs (in-list (apply map list pairs))])
(f xs)))

Resources