En los idiomas de estilo Lisp, una lista generalmente se define así:

(list 1 2 3)

Para los propósitos de este desafío, todas las listas solo contendrán enteros positivos u otras listas. También dejaremos de lado la listpalabra clave al principio, por lo que la lista ahora se verá así:

(1 2 3)

Podemos obtener el primer elemento de una lista usando car. Por ejemplo:

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

Y podemos obtener la lista original con el primer elemento eliminado con cdr:

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

Importante: cdrsiempre devolverá una lista, incluso si esa lista tuviera un solo elemento:

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

Las listas también pueden estar dentro de otras listas:

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

Escriba un programa que devuelva el código que usa cary cdrpara devolver cierto número entero en una lista. En el código que devuelve su programa, puede suponer que la lista está almacenada l, el entero objetivo está enl algún lugar y que todos los enteros son únicos.

Ejemplos:

Entrada: (6 1 3) 3

Salida: (car (cdr (cdr l)))

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

Salida: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Entrada: (1 12 1992) 1

Salida: (car l)

CJam, 59

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

Pruébalo en línea

Explicación:

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

Lisp común, 99

La siguiente solución de 99 bytes es una versión CL de la buena respuesta de Scheme .

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

Originalmente intenté usar positiony position-if, pero resultó no ser tan compacto como me hubiera gustado (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)))))

Expandido

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

Ejemplo

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

La lista está citada, pero si realmente quieres, puedo usar una macro. El valor devuelto es ^[1] :

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

Para las pruebas, solía generar una forma lambda donde lera una variable:

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

Llamar a esto con la lista original devuelve 14.

[1] también (caddar (cddddr (caddr l)))sería bueno

Retina , 170 142 125 115 114 87 84 83 75 73 70 69 68 67 bytes

Sí, menos del 50% de más de 100 bytes de mi primer intento. :)

\b(.+)\b.* \1$
(
^.
l
\(
a
+`a *\)|\d


d
+`(.*[l)])(\w)
(c$2r $1)

Para ejecutar el código desde un solo archivo, use el -s bandera.

Todavía no estoy convencido de que esto sea óptimo ... No tendré mucho tiempo en los próximos días, eventualmente agregaré una explicación.

Pyth, 62 bytes

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

Pruébelo en línea: demostración o pruebas

Explicación:

El primer bit JvXz"() ,][")reemplaza los caracteres "() "con los caracteres "[],"en la cadena de entrada, que termina en una representación de una lista de estilo Python. Lo evalúo y lo guardo enJ .

Luego reduzco la cadena G = "l"con u...\l. Aplico la función interna ...varias veces Ghasta que el valor de Gya no cambia y luego imprimoG .

La función interna hace lo siguiente: Si Jya es igual al número de entrada, no modifique G( ?qJQG). De lo contrario, aplanaré la lista J[:1]y comprobaré si el número de entrada está en esa lista y guardaré esto en la variable K( K}Quu+GHNY<J1)). Tenga en cuenta que Pyth no tiene un operador de aplanamiento, por lo que esto requiere bastantes bytes. Si Kes verdadero, entonces actualizo J con J[0], de lo contrario con J[1:]( =J?KhJtJ). Y luego reemplazo Gcon "(cdr G)"y reemplazo dela , si Kes verdadero ( ++XWK"(cdr "\d\aG\)).

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

PHP - 177 bytes

He agregado algunas líneas nuevas para facilitar la lectura:

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

Aquí está la versión sin golf:

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

Haskell, 190 188 bytes

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

evalúa a

"(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++")"

Lisp común, 168 bytes

Algo estúpido de recursión, probablemente podría condensarse un poco más:

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

Bastante impreso:

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