Nelle lingue in stile Lisp, un elenco è generalmente definito come questo:

(list 1 2 3)

Ai fini di questa sfida, tutte le liste conterranno solo numeri interi positivi o altre liste. Tralasceremo anche la listparola chiave all'inizio, quindi l'elenco apparirà così:

(1 2 3)

Possiamo ottenere il primo elemento di un elenco usando car. Per esempio:

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

E possiamo ottenere l'elenco originale con il primo elemento rimosso con cdr:

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

Importante: cdrrestituirà sempre un elenco, anche se tale elenco avrebbe un singolo elemento:

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

Gli elenchi possono anche essere all'interno di altri elenchi:

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

Scrivi un programma che restituisce il codice che utilizza care cdrper restituire un certo numero intero in un elenco. Nel codice restituito dal programma, si può presumere che l'elenco sia archiviato l, che il numero intero di destinazione si trovi lda qualche parte e che tutti i numeri interi siano univoci.

Esempi:

Ingresso: (6 1 3) 3

Produzione: (car (cdr (cdr l)))

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

Produzione: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Ingresso: (1 12 1992) 1

Produzione: (car l)

CJam, 59

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

Provalo online

Spiegazione:

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 comune, 99

La seguente soluzione di 99 byte è una versione CL della bella risposta dello Schema .

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

Inizialmente ho provato a utilizzare positione position-if, ma si è rivelato non compatto come avrei voluto (209 byte):

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

allargato

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

Esempio

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

L'elenco è citato, ma se vuoi davvero, posso usare una macro. Il valore restituito è ^[1] :

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

Per i test, ho usato per generare un modulo lambda in cui lera una variabile:

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

La chiamata a questo con l'elenco originale restituisce 14.

[1] (caddar (cddddr (caddr l)))sarebbe anche bello

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

Sì, a meno del 50% di oltre 100 byte dal mio primo tentativo. :)

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


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

Per eseguire il codice da un singolo file, utilizzare il -s flag.

Non sono ancora convinto che sia ottimale ... Non avrò molto tempo nei prossimi giorni, aggiungerò eventualmente una spiegazione.

Pyth, 62 byte

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

Provalo online: dimostrazione o Test Suite

Spiegazione:

Il primo bit JvXz"() ,][")sostituisce i caratteri "() "con i caratteri"[]," nella stringa di input, che termina in una rappresentazione di un elenco in stile Python. Lo valuto e lo conservo J.

Quindi riduco la stringa G = "l"con u...\l. Applico ...ripetutamente la funzione interna a G, fino al valore diG non cambia più e poi stampaG .

La funzione interna esegue le seguenti operazioni: Se Jè già uguale al numero di input, non modificare G( ?qJQG). Altrimenti appiattirò l'elenco J[:1]e controllerò se il numero di input è in quell'elenco e lo salverò nella variabile K( K}Quu+GHNY<J1)). Si noti che Pyth non ha un operatore appiattito, quindi questo richiede parecchi byte. Se Kè vero, allora aggiorno J con J[0], altrimenti con J[1:]( =J?KhJtJ). E poi sostituisco Gcon "(cdr G)"e sostituire il dla a, se Kè vero ( ++XWK"(cdr "\d\aG\)).

Schema (R5RS), 102 byte

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

Ho aggiunto alcune nuove righe per la leggibilità:

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

Ecco la versione ungolfed:

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 byte

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

valuta

"(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 comune, 168 155 byte

Qualcosa di stupido ricorsivo, probabilmente potrebbe essere condensato un po 'di più:

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

Abbastanza stampato:

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