Code Golf: Morris Sequence

Question

The Challenge

The shortest code by character count that will output the Morris Number Sequence. The Morris Number Sequence, also known as the Look-and-say sequence is a sequence of numbers that starts as follows:

1, 11, 21, 1211, 111221, 312211, ...

You can generate the sequence infinitely (i.e, you don't have to generate a specific number).

I/O Expectations

The program doesn't need to take any input (but bonus points for accepting input and thereby providing the option to start from any arbitrary starting point or number). At the very least your program must start from 1.

Output is at the very least expected to be the sequence:

1
11
21
1211
111221
312211
...

Extra Credit

If you're going for extra credit, you would need to do something like this:

$ morris 1
1
11
21
1211
111221
312211
...

$ morris 3
3
13
1113
3113
132113
...

Answer 1

GolfScript - 41 (extra credit: 40)

1{.p`n+0:c:P;{:|P=c{c`P|:P!}if):c;}%~1}do
{~.p`n+0:c:P;{:|P=c{c`P|:P!}if):c;}%1}do

What?
The procedure for getting the next number in the sequence: Convert the current number to a string, append a newline and loop over the characters. For each digit, if the previous digit P is the same, increment the counter c. Otherwise, add c and P to what will be next number, then update these variables. The newline we append allows the last group of digits to be added to the next number.

The exact details can be obtained examining the GolfScript documentation. (Note that | is used as a variable.)

Answer 2

Haskell: 115 88 85

import List
m x=do a:b<-group x;show(length b+1)++[a]
main=mapM putStrLn$iterate m"1"

This is the infinite sequence. I know it can be improved a lot - I'm fairly new to Haskell.

Bit shorter, inlining mapM and iterate:

import List
m(a:b)=show(length b+1)++[a]
f x=putStrLn x>>f(group x>>=m)
main=f"1"

Answer 3

Perl (46 characters)

$_="1$/";s/(.)\1*/length($&).$1/eg while print

Extra Credit (52 characters)

$_=(pop||1).$/;s/(.)\1*/length($&).$1/eg while print

Answer 4

Javascript 100 97

for(x=prompt();confirm(y=x);)for(x="";y;){for(c=0;y[c++]&&y[c]==y[0];);x+=c+y[0];y=y.substr(c--)}

Allows interrupting the sequence (by clicking "Cancel") so we don't lock the user-agent and peg the CPU. It also allows starting from any positive integer (extra credit).

Live Example: http://jsbin.com/izeqo/2

Answer 5

Perl, 46 characters

$_=1;s/(.)\1*/$&=~y!!!c.$1/ge while print$_,$/

Extra credit, 51 characters:

$_=pop||1;s/(.)\1*/$&=~y!!!c.$1/ge while print$_,$/

Answer 6

Mathematica - 62 53 50 chars - Extra credit included

Edit: 40 chars ... but right to left :(

Curiously if we read the sequence right to left (i.e. 1,11,12,1121, ..), 40 chars is enough

NestList[Flatten[Tally /@ Split@#] &, #2, #] &

That is because Tally generates a list {elem,counter} !

Edit: 50 chars

NestList[Flatten@Reverse[Tally /@ Split@#, 3] &, #2, #] &

Dissection: (read comments upwards)

NestList[               // 5-Recursively get the first N iterations
    Flatten@            // 4-Convert to one big list
       Reverse          // 3-Reverse to get {counter,element}
          [Tally /@     // 2-Count each run (generates {element,counter})
               Split@#, // 1-Split list in runs of equal elements
                 3] &,
                     #2,// Input param: Starting Number 
                     #] // Input param: Number of iterations

Edit: refactored

NestList[Flatten[{Length@#, #[[1]]} & /@ Split@#, 1] &, #2, #1] &

End edit ///

NestList[Flatten@Riffle[Length /@ (c = Split@#), First /@ c] &, #2, #1] &

Spaces not needed / added for clarity

Invoke with

%[NumberOfRuns,{Seed}]

My first time using "Riffle", to combine {1,2,3} and {a,b,c} into {1,a,2,b,3,c} :)

Answer 7

Here's my C# attempt using LINQ and first attempt at Code Golf:

C# - 205 194 211 198 bytes with extra credit (including C# boilerplate)

using System.Linq;class C{static void Main(string[]a){var v=a[0];for(;;){var r="";while(v!=""){int i=v.TakeWhile(d=>d==v[0]).Count();r+=i;r+=v[0];v=v.Remove(0,i);}System.Console.WriteLine(r);v=r;}}}

Readable version:

static void Main(string[] args)
{
    string value = args[0];
    for (;;)
    {
        string result = "";
        while (value != "")
        {
            int i = value.TakeWhile(d => d == value[0]).Count();
            result += i;
            result += value[0];
            value = value.Remove(0, i);
        }
        Console.WriteLine(result);
        value = result;
    }
}

Sample output:

11
21
1211
111221
312211
13112221
1113213211
...

Answer 8

Python, 97 102 115

Whitespace is supposed to be tabs:

x='1'
while 1:
    print x;y=d=''
    for c in x+'_':
        if c!=d:
            if d:y+=`n`+d
            n,d=0,c
        n+=1
    x=y

E.g.:

$ python morris.py | head
1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

Answer 9

Perl, 67 characters

including -l flag.

sub f{$_=pop;print;my$n;$n.=$+[0].$1while(s/(.)\1*//);f($n)}f(1)

Perl, 72 characters with extra credit

sub f{$_=pop;print;my$n;$n.=$+[0].$1while(s/(.)\1*//);f($n)}f(pop||1)

Answer 10

Here goes my implementation (in Prolog):

Prolog with DCGs (174 chars):

m(D):-write(D),nl,m(1,write(D),T,[nl|T],_).
m(C,D,T)-->[D],{succ(C,N)},!,m(N,D,T).
m(C,D,[G,D|T])-->[N],{G=write(C),G,D,(N=nl->(M-T-O=0-[N|R]-_,N);M-T-O=1-R-N)},!,m(M,O,R).

Plain vanilla prolog, code much more readeable (225 chars):

m(D):-
  ((D=1->write(D),nl);true),
  m([], [1,D]).

m([], [C,D|M]):-
  write(C), write(D),nl,
  reverse([D,C|M],[N|X]),
  !,
  m([N|X],[0,N]).
m([D|T], [C,D|M]):-
  succ(C,N),
  !,
  m(T,[N,D|M]).
m([Y|T],[C,D|M]):-
  write(C), write(D),
  !,
  m(T,[1,Y,D,C|M]).

To output the Morris sequence: m(D). where D is the 'starting' digit.

Answer 11

Ruby — 52

s=?1;loop{puts s;s.gsub!(/(.)\1*/){"#{$&.size}"+$1}}

Task is too simple, and too perlish...

Answer 12

C, 128 characters

uses a static buffer, guaranteed to cause segmentation fault

main(){char*c,v[4096],*o,*b,d[4096]="1";for(;o=v,puts(d);strcpy(d,v))for(c=d;*c;o+=sprintf(o,"%d%c",c-b,*b))for(b=c;*++c==*b;);}

Answer 13

Call a string "Morris-ish" if it contains nothing but digits 1-3, and does not contain any runs of more than three of a digit. If the initial string is Morris-ish, all strings iteratively generated from it will likewise be Morris-ish. Likewise, if the initial string is not Morris-ish then no generated string will be Morris-ish unless numbers greater than ten are regarded as combinations of digits (e.g. if 11111111111 is regarded as collapsing into three ones, rather than an "eleven" and a one).

Given that observation, every iteration starting with a Morris-ish seed can be done as the following sequence of find/replace operations:

111 -> CA
11 -> BA
1 -> AA
222 -> CB
22 -> BB
2 -> AB
333 -> CC
33 -> BC
3 -> AC
A -> 1
B -> 2
C -> 3

Note that a sequence is Morris-ish before the above substitution, the second character of each generated pair will be different from the second character of the preceding and following pairs; it is thus not possible to have more than three identical characters in sequence.

I wonder how many disjoint Morris-ish sequences there are?

Answer 14

Perl (extra credit), 47 chars

$_=pop.$/;{print;s/(.)\1*/$&=~y|||c.$1/ge;redo}

Answer 15

Java

My first attempt at a 'Code-Golf' I just threw this together during part of my IB CS class:

238 condensed

Condensed:

String a="1",b="1",z;int i,c;while(true){System.out.println(b);for(c=0,i=0,b="",z=a.substring(0,1);i<a.length();i++){if(z.equals(a.substring(i,i+1)))c++;else{b+=Integer.toString(c)+z;z=a.substring(i,i+1);c=1;}}b+=Integer.toString(c)+z;a=b;}

Properly formatted:

    String a = "1", b = "1", z;
    int i, c;

    while (true) {      
      System.out.println(b);

      for (c = 0, i = 0, b = "", z = a.substring(0, 1); i < a.length(); i++) {
        if (z.equals(a.substring(i, i + 1))) c++;
        else {
          b += Integer.toString(c) + z;
          z = a.substring(i, i + 1);
          c = 1;
        }
      }

      b += Integer.toString(c) + z;
      a = b;
    }

Answer 16

J, 44 characters with extra credit

(([:,#;.1@{:,.{:#{.)@(,:0<1,[:|2-/\]))^:(<9)

Unfortunately this only generates 9 iterations, but the iteration count <9 can be tweaked to be anything. Setting it to a: generates an infinite sequence but obviously this can't be printed.

Usage:

   (([:,#;.1@{:,.{:#{.)@(,:0<1,[:|2-/\]))^:(<9) 1
1 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 0 0 0 0 0 0 0 0 0 0 0 0
2 1 0 0 0 0 0 0 0 0 0 0 0 0
1 2 1 1 0 0 0 0 0 0 0 0 0 0
1 1 1 2 2 1 0 0 0 0 0 0 0 0
3 1 2 2 1 1 0 0 0 0 0 0 0 0
1 3 1 1 2 2 2 1 0 0 0 0 0 0
1 1 1 3 2 1 3 2 1 1 0 0 0 0
3 1 1 3 1 2 1 1 1 3 1 2 2 1

   (([:,#;.1@{:,.{:#{.)@(,:0<1,[:|2-/\]))^:(<11) 4
4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
3 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 3 2 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 1 3 1 2 2 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
3 1 1 3 1 1 2 2 2 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 3 2 1 1 3 2 1 3 2 2 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
1 1 1 3 1 2 2 1 1 3 1 2 1 1 1 3 2 2 2 1 1 4 0 0 0 0 0 0 0 0
3 1 1 3 1 1 2 2 2 1 1 3 1 1 1 2 3 1 1 3 3 2 2 1 1 4 0 0 0 0
1 3 2 1 1 3 2 1 3 2 2 1 1 3 3 1 1 2 1 3 2 1 2 3 2 2 2 1 1 4

Answer 17

Delphi

Delphi is a terrible golfing language, but still:

var i,n:Int32;s,t,k:string;u:char;label l;begin s:='1';l:writeln(s);t:='';u:=s[1
];n:=1;for i:=2to length(s)do if s[i]=u then inc(n)else begin str(n,k);t:=t+k+u;
u:=s[i];n:=1;end;str(n,k);t:=t+k+u;s:=t;goto l;end.

This is 211 bytes (and it compiles as it stands).

Answer 18

PHP: 111

My first attempt ever on a code golf, quite happy with the result.

for($x=1;;){echo$y=$x,"\n";for($x="";$y;){for($c=0;$y[$c++]&&$y[$c]==$y[0];);$x.=$c.$y[0];$y=substr($y,$c--);}}

Gives:

> php htdocs/golf.php
1
11
21
... (endless loop)

---

PHP with extra credit: 118

for($x=$argv[1];;){echo$y=$x,"\n";for($x="";$y;){for($c=0;$y[$c++]&&$y[$c]==$y[0];);$x.=$c.$y[0];$y=substr($y,$c--);}}

Gives:

> php htdocs/golf.php 4
4
14
1114
3114
... (to infinity and beyond)

Answer 19

Python - 98 chars

from itertools import *
L='1'
while 1:print L;L=''.join('%s'%len(list(y))+x for x,y in groupby(L))

106 chars for the bonus

from itertools import *
L=raw_input()
while 1:print L;L=''.join('%s'%len(list(y))+x for x,y in groupby(L))

Answer 20

Java - 167 chars (with credit)

_{(122 without class/main boilerplate)}

---

class M{public static void main(String[]a){for(String i=a[0],o="";;System.out.println(i=o),o="")for(String p:i.split("(?<=(.)(?!\\1))"))o+=p.length()+""+p.charAt(0);}}

---

With newlines:

class M{
 public static void main(String[]a){
  for(String i=a[0],o="";;System.out.println(i=o),o="")
   for(String p:i.split("(?<=(.)(?!\\1))"))
    o+=p.length()+""+p.charAt(0);
 }
}

Answer 21

Here's my very first attempt at code golf, so please don't be too hard on me!

PHP, 128 122 112 bytes with opening tag

122 116 106 bytes without opening tag and leading whitespace.

<?php for($a="1";!$c="";print"$a\n",$a=$c)for($j=0,$x=1;$a[$j];++$j)$a[$j]==$a[$j+1]?$x++:($c.=$x.$a[$j])&&$x=1;

(Quite a pity I have to initialize $a as a string though, costing me 2 extra bytes, otherwise I can't use index notation on it.)

Output

$ php morris.php
1
11
21
1211
111221
312211
...

PHP (extra credit), 133 127 117 bytes with opening tag

127 121 111 bytes without opening <?php tag and leading whitespace.

<?php for($a=$argv[1];!$c="";print"$a\n",$a=$c)for($j=0,$x=1;$a[$j];++$j)$a[$j]==$a[$j+1]?$x++:($c.=$x.$a[$j])&&$x=1;

Output

$ php morris.php 3
3
13
1113
3113
132113
1113122113
...
^C
$ php morris.php 614
614
161114
11163114
3116132114
1321161113122114
1113122116311311222114
...

PHP (extra credit), ungolfed with opening and closing tags

<?php

for ($a = $argv[1]; !$c = ""; print "$a\n", $a = $c)
{
    for ($j = 0, $x = 1; $a[$j]; ++$j)
    {
        // NB: this was golfed using ternary and logical AND operators:
        // $a[$j] == $a[$j + 1] ? $x++ : ($c .= $x . $a[$j]) && $x = 1;
        if ($a[$j] == $a[$j + 1])
        {
            $x++;
        }
        else
        {
            $c .= $x . $a[$j];
            $x = 1;
        }
    }
}

?>

Answer 22

C++, 310 characters.

#include <iostream>
#include <list>
using namespace std;
int main(){list<int> l(1,1);cout<<1<<endl;while(1){list<int> t;for(list<int>::iterator i=l.begin();i!=l.end();){list<int>::iterator p=i;++i;while((i!=l.end())&&(*i==*p)){++i;}int c=distance(p,i);cout<<c<<*p;t.push_back(c);t.push_back(*p);}cout<<'\n';l=t;}}

Correctly indented:

#include <iostream>
#include <list>
using namespace std;

int main() {
    list <int> l(1,1);
    cout << 1 << endl;
    while(1) {
        list <int> t;
        for (list <int>::iterator i = l.begin(); i != l.end();) {
            const list <int>::iterator p = i;
            ++i;
            while ((i != l.end()) && (*i == *p)) {
                ++i;
            }
            int c = distance(p, i);
            cout << c << *p;
            t.push_back(c);
            t.push_back(*p);
        }
        cout << '\n';
        l = t;
    }
}

Answer 23

Python - 117

My python-fu is not strong, so I did a lot of googling for this. :)

a='1'
while 1:
 print a
 a=''.join([`len(s)`+s[0]for s in''.join([x+' '*(x!=y)for x,y in zip(a,(2*a)[1:])]).split()])

The idea is to use zip to generate a list of (a[i],a[i+1]) pairs, use the inner comprehension to insert a space when a[i]!=a[i+1], join the resulting list to a string, and split on spaces, use another comprehension on this split list to replace each element with the run length of the element, and the first character, and finally join to get the next value in sequence.

Answer 24

C w/ Extra Credit, 242 (or 184)

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#define s malloc(1<<20)
main(int z,char**v){char*j=s,*k=s;strcpy(k,*++v);for(;;){strcpy(j,k);z=1;*k=0;while(*j){if(*j-*++j)sprintf(k+strlen(k),"%d%c",z,*(j-1)),z=1;else++z;}puts(k);}}

You can save another ~60 characters if you omit the includes, gcc will still compile with warnings.

$ ./a.out 11111111 | head
81
1811
111821
31181211
132118111221
1113122118312211
31131122211813112221
132113213221181113213211
111312211312111322211831131211131221
3113112221131112311332211813211311123113112211

Answer 25

C#, 204 bytes (256 with extra credit)

My first attempt at code golf

static void Main(){var v="1";for(;;){Console.Write(v + "\n");var r=v.Aggregate("", (x, y) => x.LastOrDefault()==y?x.Remove(0, x.Length-2)+(int.Parse(x[x.Length-2].ToString())+1).ToString()+y:x+="1"+y);v=r;}}

Readable version, the difference from others is that I use Linq's Aggregate function

static void Main(){
    var value="1";
    for(;;)
    {
        Console.Write(value + "\n");
        var result = value.Aggregate("", (seed, character) => 
                        seed.LastOrDefault() == character ? 
                            seed.Remove(seed.Length-2) + (int.Parse(seed[seed.Length-2].ToString())+1).ToString() + character
                            : seed += "1" + character
                    );
        value = result;
    }
}

Answer 26

Common Lisp - 124 122 115 Chars

(do((l'(1)(do(a r)((not l)r)(setf a(1+(mismatch(cdr l)l))r(,@r,a,(car l))l(nthcdr a l)))))((format t"~{~s~}~%"l)))

With formatting:

(do ((l '(1) (do (a r) ((not l) r) (setf a (1+ (mismatch (cdr l) l))
                                         r `(,@r ,a ,(car l)) l (nthcdr a l)))))
    ((format t "~{~s~}~%" l)))

Answer 27

F# - 135

let rec m l=Seq.iter(printf "%i")l;printfn"";m(List.foldBack(fun x s->match s with|c::v::t when x=v->(c+1)::v::t|_->1::x::s)l [])
m[1]

Formatted Code

let rec m l=
    Seq.iter(printf "%i")l;printfn"";
    m (List.foldBack(fun x s->
        match s with
        |c::v::t when x=v->(c+1)::v::t
        |_->1::x::s) l [])
m[1]

Still hopeful I can find a better way to print the list or use string/bigint instead.

Answer 28

PHP 72 bytes

<?for(;;)echo$a=preg_filter('#(.)\1*#e','strlen("$0"). $1',$a)?:5554,~õ;

This script might be further optmized. But since we've got at PHPGolf ({http://www.phpgolf.org/?p=challenges&challenge_id=28}) exactly the same sequence, I keep it this way.

Answer 29

Python - 92 characters

^{98 with extra credit}

Outputs infinitely. I recommend redirecting output to a file, and quickly hitting Ctrl+C.

x=`1`;t=''
while 1:
 print x
 while x:c=x[0];n=len(x);x=x.lstrip(c);t+=`n-len(x)`+c
 x,t=t,x

For the extra credit version, replace

x=`1`

with

x=`input()`

Answer 30

C - 120 characters

^{129 with extra credit}

main(){char*p,*s,*r,x[99]="1",t[99];for(;r=t,puts(p=x);strcpy(x,t))
for(;*p;*r++=p-s+48,*r++=*s,*r=0)for(s=p;*++p==*s;);}

^{The newline is there only for readability's sake.}

This stops when it segfaults (after at least 15 iterations). If your C libraries use buffered I/O, then you may not see any output before the segfault. If so, test with this code:

#include<stdio.h>
main(){char*p,*s,*r,x[99]="1",t[99];for(;r=t,puts(p=x),fflush(stdout),1;
strcpy(x,t))for(;*p;*r++=p-s+48,*r++=*s,*r=0)for(s=p;*++p==*s;);}

This adds an fflush after every output.

Ungolfed, it would look something like this:

int main(){
    char *p, *start, *result, number[99] = "1", temp[99];

    while(1){ /* loop forever */
        puts(number);

        result = temp; /* we'll be incrementing this pointer as we write */
        p = number;    /* we'll be incrementing this pointer as we read */

        while(*p){ /* loop till end of string */
            start = p; /* keep track of where we started */

            while(*p == *start) /* find all occurrences of this character */
                p++;

            *result++ = '0' + p - start; /* write the count of characters, */
            *result++ = *start;          /* the character just counted, */
            *result   = 0;               /* and a terminating null */
        }

        strcpy(number, temp); /* copy the result back to our working buffer */
    }
}

You can see it in action on ideone.

With the extra credit, the code looks like this:

main(){char*p,*s,*r,x[99],t[99];for(scanf("%s",x);r=t,puts(p=x);strcpy(x,t))
for(;*p;*r++=p-s+48,*r++=*s,*r=0)for(s=p;*++p==*s;);}