Imprimer un ensemble Cantor

19

Le défi

Construire un N-Nivelé Set Cantor .

L'ensemble ternaire Cantor est créé en supprimant à plusieurs reprises les tiers médians ouverts d'un ensemble de segments de ligne.

Le programme reçoit un paramètre N(un nombre entier) puis imprime (en console ou de manière similaire) un ensemble de Cantor de N niveaux. L'impression ne peut contenir que des caractères undescore ( _) et blancs. Le paramètre peut être positif ou négatif et le signe indique l'orientation de construction du Cantor Set: si N > 0le Cantor Set est construit vers le bas et si N < 0le Cantor Set est construit vers le haut. Si N = 0alors le programme imprime une seule ligne ( _).

Par exemple:

N = 2

_________
___   ___
_ _   _ _

N = -2

_ _   _ _
___   ___
_________

N = 3

___________________________
_________         _________
___   ___         ___   ___
_ _   _ _         _ _   _ _

N = -3

_ _   _ _         _ _   _ _
___   ___         ___   ___
_________         _________
___________________________

Critères gagnants

Comme c'est un défi de golf de code, le code le plus court gagne.

Modifié: modifiez 0 entrée par la suggestion d'Ugoren.

Averroes
la source
Pourquoi ne rien imprimer lorsque N = 0? Cela fait de 0 un cas spécial et rend plus difficile l'utilisation de la récursivité. La manipulation générale serait d'imprimer un seul _(mais imprimez-le vers le bas lorsque vous obtenez -0).
ugoren
Droite. J'ai déjà modifié les spécifications.
Averroes

Réponses:

10

GolfScript, 49 42 40 caractères

~.abs.3\?'_'*\{.3%..,' '*\++}*](0>2*(%n*

Merci à hammar pour 42-> 40.

Ma meilleure tentative à ce jour d'une approche plus théorique des nombres est malheureusement beaucoup plus longue:

~.abs:^3\?,{3^)?+3base(;1+1?.'_'*^@-)' '*+}%zip\0>2*(%n*

ou

~.abs 3\?:^,{6^*+3base.1+1?.('_'*@,@-' '*+}%zip\0>2*(%n*

et je soupçonne que la longueur de baseet ziprendra impossible de rattraper.

Peter Taylor
la source
~.abs.@/\.3\?'_'*\{.3%..,' '*\++}*](%n*est de 39 caractères, mais se bloque en entrée 0. :-(
Ilmari Karonen
@IlmariKaronen, oui, la division par zéro a été pénible pour l'implémentation C que j'ai également écrite, car cela signifiait que vous ne pouviez pas faire n/abs(n)pour l'obtenir signum(n).
Peter Taylor
6

Python, 116 113 104 103 caractères

n=input()
d=n>0 or-1
for i in range(n*d+1)[::d]:
 s='_'*3**i
 while i<n*d:s+=len(s)*' '+s;i+=1
 print s

Un algorithme plus ancien avec 113 caractères

r=input()
u='_'
l=[u]
for _ in abs(r)*u:o=len(l[0]);l=[s+o*' '+s for s in l]+[u*o*3]
print'\n'.join(l[::r>0 or-1])
Steven Rumbalski
la source
5

Rubis (97)

Basé sur la version python de Steven Rumbalski:

n,r=$*[0].to_i,[?_]
n.abs.times{z=r[0].size;r=r.map{|s|s+' '*z+s}+[?_*z*3]}
puts n<0?r:r.reverse

Tentatives précédentes, toutes deux de même longueur (112)

Créez des lignes à partir de pièces:

c=->x,n{n<1??_*x :(z=c[s=x/3,n-1])+' '*s+z}
r=(0..m=(n=$*[0].to_i).abs).map{|i|c[3**m,i]}
puts n<0?r.reverse: r

Commencez par une ligne, faites-y des trous:

r=[?_*3**a=(n=$*[0].to_i).abs]
a.times{|c|r<<r[-1].gsub((x=?_*o=3**(a-c-1))*3,x+' '*o+x)}
puts n<0?r.reverse: r
jsvnm
la source
3

Perl, 93 caractères

@x=($t=$x=_ x 3**($a=abs($n=<>)),map$x.=$"x($x=~s/(.)../$1/g).$x,1..$a);say for$n<0?sort@x:@x

Je pensais que j'essaierais de voir à quel point la solution GolfScript de Peter Taylor se porterait sur Perl. Les fonctionnalités notables incluent l'utilisation de sortau lieu de reversepour enregistrer trois caractères, en utilisant le fait qu'un espace trie avant _.

Ilmari Karonen
la source
2

Lisp commun, 217 210 caractères

(defun m(x)(flet((c(n v)(if(= n 0)`((,v))(cons(substitute v nil(make-list(expt 3 n)))(mapcar #'append(c(1- n)v)(c(1- n)" ")(c(1- n)v))))))(format t "~{~{~a~}~%~}"(let((r(c(abs x)'_)))(if(< x 1)(reverse r)r)))))

Étendu:

(defun m(x)
  (flet((c(n v)
    (if(= n 0)
       `((,v))
       (cons(substitute v nil(make-list(expt 3 n)))
            (mapcar #'append
                    (c(1- n)v)
                    (c(1- n)" ")
                    (c(1- n)v))))))
   (format t "~{~{~a~}~%~}"(let((r(c(abs x)'_)))(if(< x 1)(reverse r)r)))))

Je pense que si le code Lisp parvient à battre n'importe quel décompte initial pour une autre langue (C, 219), je vais bien :)

Paul Richter
la source
2

C ( 163 161 caractères)

i,l,N;f(n,m,s){if(n){s=--n<l?m:s;f(n,m,s);f(n,s,s);f(n,m,s);}else
putchar(m);}main(n,v)int**v;{for(i=N=abs(n=atoi(1[v]));i+1;i--)l=n<N?N-i:i,f(N,95,32),f(0,10);}

Emprunte quelques astuces de la réponse d' Ugoren , mais la logique de base est assez différente. Je ne pouvais pas suivre sa boucle for, donc il pourrait être possible de s'hybrider et d'en sauver quelques autres.

Peter Taylor
la source
2

C, 219 193 179 143 143 136 131 caractères

J'ai suivi une autre des idées de Petyer Taylor, plus une amélioration de la mienne, j'ai économisé 6 autres.
Intégré quelques conseils de @PeterTaylor, plus copié sa fonction principale, avec de légères modifications, qui sauvent un personnage (est-il juste de le copier? Étant donné qu'aucun de nous ne gagnera celui-ci, je suppose que ce n'est pas trop mal).
J'ai pensé à une amélioration significative du fonctionnement de ma récursivité, et après avoir vu la réponse de Peter Taylor, je l'ai implémentée pour reprendre la tête. En relisant sa réponse, j'ai vu que j'avais fait presque exactement ce qu'il avait fait. Cela ressemble donc à l'hybridation qu'il a suggérée.
Également simplifié la boucle main, en gardant la même longueur.
Et a pris l'astuce de Peter pour imprimer la nouvelle ligne, au lieu de puts("")- enregistre un caractère.

Supprimé intde la déclaration de variable - un avertissement, mais enregistre 4 caractères.
Le nouvel algorithme ne calcule pas 3 ^ x à l'avance, mais utilise une seule boucle pour imprimer 3 ^ x caractères.
Peut en enregistrer un de plus en le définissant int*v, mais le 64 bits ne fonctionnera pas.
Le nombre de caractères exclut les espaces (qui peuvent être supprimés).

o,i,n;
p(c) {
    n-- ?
        p(c),p(o>n?c:32),p(c)
    :
        putchar(c);
    n++;
}
main(c,v)int**v; {
    for(n=abs(c=atoi(v[1]));i<=n;i++)o=c+n?n-i:i,p(95),puts("");
}

Algorithme plus ancien, 219 caractères:

p(l,o,i,m,c,j) {
    for(;i<(m=l);i++)
        for(j=0,c=95;m/o||!putchar(c);j++)
            i/m%3-1||(c=32),m/=3;
    puts("");
}
main(c,v,n,i,l,o)int**v;{
    (n=atoi(v[1]))<0?n=-n:(c=0);
    for(i=n,l=1;i;i--)l*=3;
    o=c?1:l;
    for (;i<=n;i++)p(l,o,0),c?o*=3:(o/=3);
}
ugoren
la source
@PeterTaylor, je ne peux pas supprimer le iparamètre, car l'utilisation du global interférerait avec main. l--va interférer avec o>=l, et je vais devoir le remplacer par >(alors pourquoi dois-je l'écrire comme si c'était une mauvaise chose?) Je pourrais aussi vous copier main, ce qui est plus simple et plus court que le mien.
ugoren
@PeterTaylor, tu avais raison i- j'ai raté le fait que je ne l'utilise vraiment plus (je pensais que tu veux dire que je ne le passe pas).
ugoren
Soit dit en passant, cela ne me dérange pas que vous preniez ma fonction principale. Ma règle d'or est que copier la solution de quelqu'un d'autre pour changer un seul caractère est trop agressif, copier la solution de quelqu'un d'autre pour en réécrire la moitié est parfaitement juste, et il y a une zone grise quelque part entre les deux. Nous devrions peut-être essayer de convenir de certaines normes communautaires sur les méta.
Peter Taylor
@PeterTaylor, je pense que nous avons atteint une sorte d'impasse. Mon psemble tout à fait optimal maintenant, et le vôtre mainétait meilleur (je ne suis pas sûr qu'il soit optimal, mais je ne peux pas l'améliorer davantage). Donc, à l'exception d'une nouvelle structure de programme ingénieuse, la seule façon de procéder était de copier l'un ou l'autre code de l'autre.
ugoren
BTW Comment comptez-vous vos personnages? Parce que je fais votre dernière version 138 caractères, pas 136.
Peter Taylor
2

J, 44 39 38 37 octets

' _'{~0&>_&(]|.)(,:1)1&(,],.0&*,.])~|

Utilise l'itération pour construire l'ensemble suivant en commençant par 1 (représentant _) initialement.

Usage

   f =: ' _'{~0&>_&(]|.)(,:1)1&(,],.0&*,.])~|
   f 0
_
   f 1
___
_ _
   f _1
_ _
___
   f 2
_________
___   ___
_ _   _ _
   f _2
_ _   _ _
___   ___
_________
   f 3
___________________________
_________         _________
___   ___         ___   ___
_ _   _ _         _ _   _ _
   f _3
_ _   _ _         _ _   _ _
___   ___         ___   ___
_________         _________
___________________________

Explication

' _'{~0&>_&(]|.)(,:1)1&(,],.0&*,.])~|  Input: integer n
                                    |  Absolute value of n
                (,:1)                  The array [1]
                     1&(          )~   Repeat abs(n) times starting with x = [1]
                                 ]       Identity function, gets x
                            0&*          Multiply x by 0
                               ,.        Join the rows together
                         ]               Identity function, gets x
                          ,.             Join the rows together
                     1  ,                Prepend a row of 1's and return
      0&>                              Test if n is negative, 1 if true else 0
         _&(   )                       If n is negative
             |.                          Reverse the previous result
            ]                            Return that
                                       Else pass the previous result unmodified
' _'                                   The string ' _'
    {~                                 Select from the string using the result
                                       as indices and return
miles
la source
Agréable! Je n'ai pas personnellement essayé, mais j'aime utiliser l'agenda - @.peut-être, combiné avec $:, pourrait être utile ici? Par exemple quelque chose comme (zero case)`(positive case)`(negative case)@.*, ou même peut-être ":@_:`(positive case)`(|."1@$:)@.*.
Conor O'Brien
Je n'ai pas tenté de solution récursive, mais je pourrais l'essayer.
miles
2

R , 141 139 137 octets

m=abs(n<-scan());write("if"(n<m,rev,c)(c(" ","_")[Reduce(`%x%`,rep(list(matrix(c(1,1,1,1,0,1),3)),m),t(1))[,1+2^m-2^(m:0)]+1]),1,3^m,,"")

Essayez-le en ligne!

-15 octets merci aussi à Giuseppe d'utiliser '('comme fonction d'identité; writeau lieu d' catimprimer la sortie; utilisation intelligente de %x%.

-2 octets grâce à Kirill L. en utilisant cau lieu de '('comme fonction d'identité.

JayCe
la source
un produit Kronecker pourrait-il fonctionner ici? %x%? Il pourrait y avoir des problèmes avec la prise de lignes alternées peut-être ...
Giuseppe
@ Giuseppe J'ai essayé, en s'appuyant sur votre réponse "Créer un" H "à partir de" H "plus petits ... Je vais essayer à nouveau.
JayCe
Ah, c'est donc vous qui avez voté pour cela. c'est la seule raison à laquelle j'ai pensé kronaussi! J'imagine que cela devrait pouvoir descendre jusqu'à 125 octets si nous pouvons trouver la bonne approche.
Giuseppe
vous pouvez utiliser `(`comme fonction d'identité afin que vous puissiez utiliser writedirectement au lieu de catet une forboucle. 141 octets
Giuseppe
@Giuseppe Je ne savais pas que cela (pourrait être utilisé de cette façon, ou que cela if pourrait être utilisé pour sélectionner parmi deux fonctions. Et je vais commencer à utiliser l'écriture ... enregistre beaucoup de "\ n".
JayCe
1

Python, 177 164 caractères

N=input()
n=abs(N)
c=lambda x:0if x<1 else x%3==1or c(x/3)
r=["".join([["_"," "][c(x/3**i)]for x in range(3**n)])for i in range(n+1)]
print"\n".join(r[::N>0 or-1])
Ante
la source
Puisque vous utilisez Python 2, vous n'avez pas besoin de convertir les résultats de inputas int. Vos deux dernières lignes pourraient être raccourcies enprint"\n".join(r[::N>0 or-1])
Steven Rumbalski
@Steven j'ai fait des changements. Je vous remercie.
Ante
1

Perl, 113 caractères

$i=abs($I=<>);@w=$_='_'x3**$i;while($i--){$x=3**$i;s/(__){$x}/'_'x$x.' 'x$x/eg;push@w,$_}say for$I>0?reverse@w:@w

Étendu:

$i=abs($I=<>);
@w=$_='_'x3**$i;
while($i--){
    $x=3**$i;
    s/(__){$x}/'_'x$x.' 'x$x/eg;
    push@w,$_
}
say for$I>0?reverse@w:@w
Toto
la source
1

JavaScript 121 octets

Fonction récursive intérieure, puis s'occuper de la sortie arrière si nécessaire

n=>(f=(n,t=n&&f(n-1),r=t[0])=>n?[r+r+r,...t.map(x=>x+t[n]+x)]:['_',' '],f=f(n<0?-n:n),f.pop(),n<0?f.reverse():f).join`\n`

Moins golfé

n=>{
  var f = n => { // recursive function
    var t = n && f(n-1), r = t[0]
    return n 
      ? [r+r+r, ...t.map(x => x+t[n]+x)]
      : ['_',' ']
  };
  f = f(n < 0 ? -n : n);
  f.pop(); // last row is all blanks
  if (n<0) f.reverse();
  return f.join`\n`
}

Tester

var F=
n=>(f=(n,t=n&&f(n-1),r=t[0])=>n?[r+r+r,...t.map(x=>x+t[n]+x)]:['_',' '],f=f(n<0?-n:n),f.pop(),n<0?f.reverse():f).join`\n`

function go()
{
  var n=+I.value
  O.textContent = F(n)
}

go()
<input id=I type=number value=3 oninput='go()'>
<pre id=O></pre>

edc65
la source
1

Lot, 265 262 242 236 235 octets

@echo off
set/pn=
set c=%n%,-1,0
if %n% lss 0 set c=0,1,%n:-=%
for /l %%i in (%c%)do call:l %%i
exit/b
:l
set s=_
for /l %%j in (1,1,%n:-=%)do call:m %1 %%j
echo %s%
:m
set t=%s%
if %1 lss +%2 set t=%s:_= %
set s=%s%%t%%s%

Edit: 12 19 octets enregistrés grâce à @ l4m2. 8 octets enregistrés en supprimant la %a%variable inutile .

Neil
la source
Ceci pour 247 octets.
Conor O'Brien
@ ConorO'Brien Remarquez que ce serait 261 si je comptais tous les CR ainsi que les LF (ce que je suis sûr que vous n'êtes pas obligé de faire mais je suis paresseux comme ça).
Neil
Vous ne supprimez donc pas les CR de votre code? Même s'il n'est pas requis par les fichiers .BAT et supprimé par SE de toute façon? : P
Conor O'Brien
@ ConorO'Brien C'est une pénalité que j'accepte d'utiliser le Bloc-notes pour écrire des fichiers batch.
Neil
Pouvez-vous faire quelque chose comme ça set c=%n%,-1,0 [LF] if %n% lss 0 set c=0,1,%a% [LF] for /l %%i in (%c%)do call:l %%i?
l4m2
0

JavaScript (Node.js) , 148 octets

n=>f=(L=n<0&&n,R=n>0&&n)=>[...Array(r=3**(n>0?n:-n))].map(_=>((j++).toString(3)+1).indexOf(1)>(L>0?L:-L)?'_':' ',j=r+r).join``+`
${L++<R?f(L,R):''}`

Essayez-le en ligne!

l4m2
la source
0

Prolog (SWI) , 265 232 213 octets

S-E-R:-between(S,E,R).
[]/R/R.
[H|T]/B/R:-T/[H,32,H|B]/R.
N+R:-(N>0->O is N-1,O+S,S/[]/R;R=`_`).
N*[H|T]:-1-N-_,writef("%n",[H]);N*T.
_*[]:-nl.
-N:-(0-N-J,K is N-J;N-0-I,J is -I,K is I-N),L is 3^K,J+R,L*R,1=0;1=1.

Essayez-le en ligne!

ASCII uniquement
la source
0

PowerShell , 111 octets

filter f{if($s=[math]::Sign($_)){($x=$_-$s|f|%{$_+' '*($l=$_|% Le*)+$_})|?{$s-1};'_'*3*$l;$x|?{$s+1}}else{'_'}}

Essayez-le en ligne!

Moins golfé:

filter f{
    if($sign=[math]::Sign($_)){
        $x=$_-$sign|f|%{
            $_+' '*($length=$_|% Length)+$_
        }
        $x|?{$sign-1}  # output $x if $_ is negative
        '_'*3*$length
        $x|?{$sign+1}  # output $x if $_ is positive
    }
    else{
        '_'
    }
}
mazzy
la source