Dans les langages de style Lisp, une liste est généralement définie comme ceci:

(list 1 2 3)

Aux fins de ce défi, toutes les listes ne contiendront que des entiers positifs ou d'autres listes. Nous laisserons également de côté le listmot - clé au début, donc la liste ressemblera maintenant à ceci:

(1 2 3)

Nous pouvons obtenir le premier élément d'une liste en utilisant car. Par exemple:

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

Et nous pouvons obtenir la liste d'origine avec le premier élément supprimé avec cdr:

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

Important: cdrretournera toujours une liste, même si cette liste aurait un seul élément:

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

Les listes peuvent également figurer dans d'autres listes:

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

Écrivez un programme qui renvoie du code qui utilise caret cdrpour renvoyer un certain entier dans une liste. Dans le code renvoyé par votre programme, vous pouvez supposer que la liste est stockée dans l, l'entier cible est lquelque part et que tous les entiers sont uniques.

Exemples:

Contribution: (6 1 3) 3

Production: (car (cdr (cdr l)))

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

Production: (car (cdr (car (cdr (cdr (cdr (cdr (car (cdr (cdr l))))))))))

Contribution: (1 12 1992) 1

Production: (car l)

CJam, 59

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

Essayez-le en ligne

Explication:

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

La solution suivante de 99 octets est une version CL de la belle réponse 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))))))

À l'origine, j'ai essayé d'utiliser positionet position-if, mais il s'est avéré que ce n'était pas aussi compact que j'aurais aimé (209 octets):

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

Étendu

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

Exemple

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

La liste est citée, mais si vous voulez vraiment, je peux utiliser une macro. La valeur renvoyée est ^[1] :

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

Pour les tests, j'avais l'habitude de générer un formulaire lambda où se ltrouvait une variable:

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

L'appel avec la liste d'origine renvoie 14.

[1] (caddar (cddddr (caddr l)))serait bien aussi

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

Oui, moins de 50% de plus de 100 octets sur ma première tentative. :)

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


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

Pour exécuter le code à partir d'un seul fichier, utilisez l' -sindicateur.

Je ne suis toujours pas convaincu que ce soit optimal ... Je n'aurai pas beaucoup de temps dans les prochains jours, j'ajouterai éventuellement une explication.

Pyth, 62 octets

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

Essayez-le en ligne: démonstration ou suite de tests

Explication:

Le premier bit JvXz"() ,][")remplace les caractères "() "par les caractères "[],"de la chaîne d'entrée, qui se termine par une représentation d'une liste de style Python. Je l'évalue et je la stocke J.

Ensuite, je réduis la chaîne G = "l"avec u...\l. J'applique la fonction interne à ...plusieurs reprises Gjusqu'à ce que la valeur de Gne change plus, puis j'imprime G.

La fonction interne fait ce qui suit: Si Jest déjà égal au numéro d'entrée, alors ne modifiez pas G( ?qJQG). Sinon, je vais aplatir la liste J[:1]et vérifier si le numéro d'entrée est dans cette liste et l'enregistrer dans la variable K( K}Quu+GHNY<J1)). Notez que Pyth n'a pas d'opérateur d'aplatissement, donc cela prend pas mal d'octets. Si Kc'est vrai, je mets à jour J avec J[0], sinon avec J[1:]( =J?KhJtJ). Et puis je remplace Gpar "(cdr G)"et remplace le dthe a, if Kest vrai ( ++XWK"(cdr "\d\aG\)).

Schéma (R5RS), 102 octets

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

J'ai ajouté quelques nouvelles lignes pour la lisibilité:

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

Voici la version non golfée:

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 octets

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

évalue à

"(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 commun, 168155 octets

Quelque chose de récursif stupide, il pourrait probablement être un peu plus condensé:

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

Assez imprimé:

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