Lisp Extraction Mission

Question

In Lisp style languages, a list is usually defined like this:

(list 1 2 3)

For the purposes of this challenge, all lists will only contain positive integers or other lists. We will also leave out the list keyword at the start, so the list will now look like this:

(1 2 3)

We can get the first element of a list by using car. For example:

(car (1 2 3))
==> 1

And we can get the original list with the first element removed with cdr:

(cdr (1 2 3))
==> (2 3)

Important: cdr will always return a list, even if that list would have a single element:

(cdr (1 2))
==> (2)
(car (cdr (1 2)))
==> 2

Lists can also be inside other lists:

(cdr (1 2 3 (4 5 6)))
==> (2 3 (4 5 6))

Write a program that returns code that uses car and cdr to return a certain integer in a list. In the code that your program returns, you can assume that the list is stored in l, the target integer is in l somewhere, and that all the integers are unique.

Examples:

Input: (6 1 3) 3

Output: (car (cdr (cdr l)))

Input: (4 5 (1 2 (7) 9 (10 8 14))) 8

Output: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Input: (1 12 1992) 1

Output: (car l)

• Martin Ender: Can we take input with the integer first and the list second?
• absinthe: @MartinBüttner Sure.
• coredump: What about (1 2 3) 16, shall we return ()?
• absinthe: @coredump Good question. You can assume that the target integer will always be in the expression, so a case like (1 2 3) 16 will never show up.
• Blackhole: Can we receive two inputs, one for the list and one for the integer?

Answer 1

Common Lisp, 99

The following 99 bytes solution is a CL version of the nice Scheme answer.

(defun g(l n &optional(o'l))(if(eql n l)o(and(consp l)(or(g(car l)n`(car,o))(g(cdr l)n`(cdr,o))))))

I originally tried to make use of position and position-if, but it turned out to be not as compact as I would have liked (209 bytes):

(lambda(L x &aux(p'l))(labels((f(S &aux e)(cons(or(position x S)(position-if(lambda(y)(if(consp y)(setf e(f y))))S)(return-from f()))e)))(dolist(o(print(f L))p)(dotimes(i o)(setf p`(cdr,p)))(setf p`(car,p)))))

Expanded

(lambda
 (l x &aux (p 'l))
 (labels ((f (s &aux e)
 (cons
 (or (position x s)
 (position-if
 (lambda (y)
 (if (consp y)
 (setf e (f y))))
 s)
 (return-from f nil))
 e)))
 (dolist (o (print (f l)) p)
 (dotimes (i o) (setf p `(cdr ,p)))
 (setf p `(car ,p)))))

Example

(funcall *fun* '(4 5 (1 2 (7) 9 (10 8 14))) 14)

The list is quoted, but if you really want, I can use a macro. The returned value is^[1]:

(CAR (CDR (CDR (CAR (CDR (CDR (CDR (CDR (CAR (CDR (CDR L)))))))))))

For tests, I used to generate a lambda form where l was a variable:

(LAMBDA (#:G854) (CAR (CDR (CDR (CAR (CDR (CDR (CDR (CDR (CAR (CDR (CDR #:G854))))))))))))

Calling this with the original list returns 14.

---

[1] (caddar (cddddr (caddr l))) would be nice too

• DanTheMan: You answered a question about Lisp with Lisp! It's Lisp-ception!
• coredump: @DanTheMan Lisp-ception is pretty much what defines Lisp ;-)

Answer 2

Retina, (削除) 170 (削除ここまで) (削除) 142 (削除ここまで) (削除) 125 (削除ここまで) (削除) 115 (削除ここまで) (削除) 114 (削除ここまで) (削除) 87 (削除ここまで) (削除) 84 (削除ここまで) (削除) 83 (削除ここまで) (削除) 75 (削除ここまで) (削除) 73 (削除ここまで) (削除) 70 (削除ここまで) (削除) 69 (削除ここまで) (削除) 68 (削除ここまで) 67 bytes

Yay, (削除) less than 50% of (削除ここまで) more than 100 bytes off my first attempt. :)

\b(.+)\b.* 1円$
(
^.
l
\(
a
+`a *\)|\d
d
+`(.*[l)])(\w)
(c2ドルr 1ドル)

To run the code from a single file, use the -s flag.

I'm still not convinced this is optimal... I won't have a lot of time over the next few days, I will add an explanation eventually.

Answer 3

Pyth, 62 bytes

JvXz"() ,][")u?qJQG&=J?K}Quu+GHNY<J1)hJtJ++XWK"(cdr "\d\aG\)\l

Try it online: Demonstration or Test Suite

Explanation:

The first bit JvXz"() ,][") replaces the chars "() " with the chars "[]," in the input string, which ends up in a representation of a Python-style list. I evaluate it and store it in J.

Then I reduce the string G = "l" with u...\l. I apply the inner function ... repeatedly to G, until the value of G doesn't change anymore and then print G.

The inner function does the following: If J is already equal to the input number, than don't modify G (?qJQG). Otherwise I'll flatten the the list J[:1] and check if the input number is in that list and save this to the variable K (K}Quu+GHNY<J1)). Notice that Pyth doesn't have a flatten operator, so this is takes quite a few bytes. If K is true, than I update J with J[0], otherwise with J[1:] (=J?KhJtJ). And then I replace G with "(cdr G)" and replace the d the a, if K is true (++XWK"(cdr "\d\aG\)).

Answer 4

Scheme (R5RS), 102 bytes

(let g((l(read))(n(read))(o'l))(if(pair? l)(or(g(car l)n`(car,o))(g(cdr l)n`(cdr,o)))(and(eq? n l)o)))

Answer 5

CJam, 59

q"()""[]"er~{:AL>{0jA1<e_-_A(?j'l/"(car l)"@{2'dt}&*}"l"?}j

Try it online

Explanation:

q read the input
"()""[]"er replace parentheses with square brackets
~ evaluate the string, pushing an array and a number
{...}j calculate with memoized recursion using the array as the argument
 and the number as the memozied value for argument 0
 :A store the argument in A
 L> practically, check if A is an array
 if A is a (non-empty) array, compare with an empty array
 (result 1, true)
 if A is a number, slice the empty array from that position
 (result [], false)
 {...} if A is an array
 0j get the memoized value for 0 (the number to search)
 A1< slice A keeping only its first element
 e_ flatten array
 - set difference - true iff the number was not in the array
 _ duplicate the result (this is the car/cdr indicator)
 A( uncons A from left, resulting in the "cdr" followed by the "car"
 ? choose the cdr if the number was not in the flattened first item,
 else choose the car
 j call the block recursively with the chosen value as the argument
 'l/ split the result around the 'l' character
 "(car l)" push this string
 @ bring up the car/cdr indicator
 {...}& if true (indicating cdr)
 2'dt set the character in position 2 to 'd'
 * join the split pieces using the resulting string as a separator
 "l" else (if A is not an array) just push "l"
 (we know that when we get to a number, it is the right number)
 ? end if

Answer 6

PHP - 177 bytes

I've added some newlines for readability:

function f($a,$o,$n){foreach($a as$v){if($n===$v||$s=f($v,$o,$n))return
'(car '.($s?:$o).')';$o="(cdr $o)";}}function l($s,$n){echo f(eval(strtr
("return$s;",'() ','[],')),l,$n);}

Here is the ungolfed version:

function extractPhp($list, $output, $number)
{
 foreach ($list as $value)
 {
 if (is_int($value))
 {
 if ($value === $number) {
 return '(car '. $output .')';
 }
 }
 else
 {
 $subOutput = extractPhp($value, $output, $number);
 if ($subOutput !== null) {
 return '(car '. $subOutput .')';
 }
 }
 $output = '(cdr '. $output .')';
 }
}
function extractLisp($stringList, $number)
{
 $phpCode = 'return '. strtr($stringList, '() ','[],') .';';
 $list = eval($phpCode);
 echo extractPhp($list, 'l', $number);
}

Answer 7

Haskell, (削除) 190 (削除ここまで) 188 bytes

l "(4 5 (1 2 (7) 9 (10 8 14)))" 8

evaluates to

"(car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))"

l(h:s)n=c$i(show n)s""""
i n(h:s)t l|h>'/'&&h<':'=i n s(t++[h])l|t==n='a':l|h=='('=j$'a':l|h==')'=j$tail$dropWhile(=='d')l|0<1=j$'d':l where j=i n s""
c[]="l"
c(h:s)="(c"++h:"r "++c s++")"

• nimi: You can turn (and c in function c into a string: c(h:s)="(c"++h:...
• Leif Willerts: Wow, didn't think that would work with h being a Char!

Answer 8

Common Lisp, (削除) 168 (削除ここまで) 155 bytes

Some stupid recursion thing, it could probably be condensed a bit more:

(lambda(l e)(labels((r(l o)(setf a(car l)d(cdr l)x`(car,o)y`(cdr,o))(if(equal e a)x(if(atom a)(r d y)(if(find e l)(r d y)(if d(r d y)(r a x)))))))(r l'l)))

Pretty printed:

(lambda (l e)
 (labels ((r (l o)
 (setf a (car l) d (cdr l)
 x `(car ,o) y `(cdr ,o))
 (if (equal e a) x
 (if (atom a)
 (r d y)
 (if (find e l)
 (r d y)
 (if d
 (r d y)
 (r a x)))))))
 (r l 'l)))