Print a Cantor Set

Question

The Challenge

Build a N-Leveled Cantor Set.

The Cantor ternary set is created by repeatedly deleting the open middle thirds of a set of line segments.

The program receives one parameter N (a integer number) and then prints (in console or similar way) a Cantor Set of N levels. The print can only contain undescore (_) and whithe spaces characters. The parameter can be positive or negative and the sign indicates the Cantor Set construction orientation: If N > 0 the Cantor Set is constructed downwards and if N < 0 the Cantor Set is constructed upwards. If N = 0 then the program prints a single line (_).

For example:

N = 2

_________
___   ___
_ _   _ _

N = -2

_ _   _ _
___   ___
_________

N = 3

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

N = -3

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

Winning criteria

As it is a code golf challenge, the shortest code wins.

Edited: Modify 0 input by ugoren's suggestion.

Answer 1

GolfScript, 49 42 40 chars

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

With thanks to hammar for 42->40.

My best attempt yet at a more number-theoretic approach is sadly much longer:

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

or

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

and I suspect that the length of base and zip will make it impossible to catch up.

Answer 2

Python, 116 113 104 103 chars

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

Older algorithm topped out at 113 characters

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

Answer 3

Ruby (97)

Based on Steven Rumbalski's python version:

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

Previous attempts, both same length (112)

Build lines from parts:

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

Start with one line, make holes in it:

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

Answer 4

APL (Dyalog Unicode), 32 31 bytes^SBCS

{' _'[⊖⍣(0>⍵)∧⍀1⍪1≠3⊥⍣¯1⍳3*|⍵]}

Try it online!

Saved 1 byte thanks to Adám by changing the conditional flipping ⊖⍣(0>⍵) to inside the indexing.

How it works:

This answer builds on the mathematical properties of the Cantor set itself. It is known that a number is in the Cantor set iff its ternary expansion contains no 1s. So what we do is discretize the interval [0, 1], compute the ternary expansion of the numbers in there, check which ones have a 1 in their ternary expansion and exclude them from the subsequent iterations of the drawing.

{' _'[⊖⍣(0>⍵)∧⍀1⍪1≠3⊥⍣¯1⍳3*|⍵]}   ⍝ dfn expecting an integer as right argument (e.g. 2)
                         ⍳3*|⍵     ⍝ discretize the interval (e.g. 0 1 2 3 4 5 6 7 8)
                   3⊥⍣¯1           ⍝ compute the ternary expansion in columns (e.g.
                                   ⍝    0 0 0 1 1 1 2 2 2
                                   ⍝    0 1 2 0 1 2 0 1 2 )
               1⍪1≠                ⍝ find which numbers are ≠ from 1 and
                                   ⍝ append a row of 1s (e.g.
                                   ⍝    1 1 1 1 1 1 1 1 1
                                   ⍝    1 1 1 0 0 0 1 1 1
                                   ⍝    1 0 1 1 0 1 1 0 1 )
             ∧⍀                    ⍝ propagate the 0s downwards (e.g. 
                                   ⍝    1 1 1 1 1 1 1 1 1
                                   ⍝    1 1 1 0 0 0 1 1 1
                                   ⍝    1 0 1 0 0 0 1 0 1 )
      ⊖⍣(0>⍵)                     ⍝ mirror if the input number is negative
 ' _'[                        ]    ⍝ and index into ' _' to draw

Answer 5

Perl, 93 chars

@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

I thought I'd try to see how well Peter Taylor's GolfScript solution would port to Perl. Notable features include the use of sort instead of reverse to save three chars, using the fact that a space sorts before _.

Answer 6

Common Lisp, 217 210 characters

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

Expanded:

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

I figure if the Lisp code manages to beat any initial count for another language (C, 219) I'm doing OK :)

Answer 7

C (163 161 chars)

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

Borrows a couple of tricks from ugoren's answer, but the core logic is quite different. I couldn't follow his for loop, so it may be possible to hybridise and save a few more.

Answer 8

C, 219 193 179 143 136 131 characters

Followed another of Petyer Taylor's ideas, plus an improvement of my own, saved 6 more.
Integrated some tips from @PeterTaylor, plus copied his main function, with slight changes, which save a character (is it fair to copy it? Since neither of us will win this one, I guess it isn't too bad).
I thought of a significant improvement in how my recursion works, and after seeing Peter Taylor's answer, I implemented it to regain the lead. When reading his answer again, I saw that I did almost exactly what he did. So this seems like the hybridization he suggested.
Also simplified the loop in main, keeping the same length.
And took Peter's trick to print newline, instead of puts("") - saves a character.

Removed int from variable declaration - a warning, but saves 4 chars.
New algorithm doesn't calculate 3^x in advance, but uses a single loop to print 3^x characters.
Can save one more by defining int*v, but then 64bit won't work.
Characters count excludes whitespace (which can be removed).

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

Older algorithm, 219 chars:

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

Answer 9

J, 44 39 38 37 bytes

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

Uses iteration to build the next set starting with 1 (representing _) initially.

Usage

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

Explanation

' _'{~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

Answer 10

R, 141 139 137 bytes

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,,"")

Try it online!

-15 bytes thanks too Giuseppe's use of '(' as the identity function; write instead of cat to print output; clever use of%x%.

-2 bytes thanks to Kirill L. by using c instead of '(' as the identity function.

Answer 11

Python, 177 164 characters

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

Answer 12

Perl, 113 chars

$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

Expanded:

$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

Answer 13

JavaScript 121 bytes

Inner recursive function, then take care of backward output if needed

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`

Less golfed

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`
}

Test

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>

Answer 14

Batch, 265 262 242 236 235 bytes

@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: Saved 12 19 bytes thanks to @l4m2. Saved 8 bytes by removing the unnecessary %a% variable.

Answer 15

PowerShell, 111 bytes

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

Try it online!

Less golfed:

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{
        '_'
    }
}

Answer 16

Husk, 31 bytes

*±¹↑→a¹¡oṁ§ṘȯJ' R2←o/3LgR'_`^3a

Try it online!

Doesn't really use the cantor set, just uses a replacement method (and an infinite list).

Now, you may ask: why is an infinite list useful here? Here's an explanation:

Explanation

¡oṁ§ṘȯJ' R2←o/3LgR'_`^3a
                       a take abs(n) 
                 R'_`^3 repeat underscore n times(take n=3)
¡o                      iterate on this string, collecting results
                g       group the string into equal runs:
                        ["_________"]
  ṁ                     map each group to the following, and concatenate:
         R2←            repeat the first character twice
      J'                join with spaces
                        "_________" → "_ _"
            o/3L        take length /3 → 3
   §Ṙ                   Repeat each character that many times
                        "___   ___"

Then:
   ↑→a¹ take n+1 elements from the list
*±¹     multiply by sign(n) (reverse if negative)

Answer 17

JavaScript (Node.js), 148 bytes

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):''}`

Try it online!

Answer 18

Python 2, 102 bytes

lambda n:'\n'.join(eval("[i+' '*len(i)+i for i in"*abs(n)+"'_'"+"]+['___'*len(i)]"*abs(n))[::n<1or-1])

Try it online!

Answer 19

Prolog (SWI), 265 232 213 bytes

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.

Try it online!

Answer 20

Rust, 243 bytes

|i:i8|(0..i.abs() as usize).any(|j|print!("{}
",if i>0{f(j,3usize.pow(i as u32-1))}else{f(-i as usize-j-1,3usize.pow(-i as u32-1))})>());fn f(i:usize,j:usize)->String{if i<1{"_".repeat(j)}else{[f(i-1,j/3)," ".repeat(j/3),f(i-1,j/3)].concat()}}

Once again I win the prize for the longest answer

Attempt This Online!

Rust, 247 bytes

|x:i32|->String{let r=(0..x.abs() as u32).map(|d|{(0..3_usize.pow(x.abs() as u32-1)).map(move|w|if(0..d).all(|v|w/3_usize.pow(x.abs() as u32-2-v)%3!=1){'_'}else{' '}).chain(['\n'])});if x<0{r.rev().flatten().collect()}else{r.flatten().collect()}};

Attempt This Online!