Look-and-say sequence

Look-and-say sequence
You are encouraged to solve this task according to the task description, using any language you may know.

Sequence Definition

• Take a decimal number
• Look at the number, visually grouping consecutive runs of the same digit.
• Say the number, from left to right, group by group; as how many of that digit there are - followed by the digit grouped.

This becomes the next number of the sequence.

The sequence is from John Conway, of Conway's Game of Life fame.

An example:

• Starting with the number 1, you have one 1 which produces 11.
• Starting with 11, you have two 1's i.e. 21
• Starting with 21, you have one 2, then one 1 i.e. (12)(11) which becomes 1211
• Starting with 1211 you have one 1, one 2, then two 1's i.e. (11)(12)(21) which becomes 111221

Write a program to generate successive members of the look-and-say sequence.

Ada

<lang ada>with Ada.Text_IO, Ada.Strings.Fixed; use Ada.Text_IO, Ada.Strings, Ada.Strings.Fixed;

function "+" (S : String) return String is

  Item : constant Character := S (S'First);

begin

  for Index in S'First + 1..S'Last loop
     if Item /= S (Index) then
        return Trim (Integer'Image (Index - S'First), Both) & Item & (+(S (Index..S'Last)));
     end if;
  end loop;
  return Trim (Integer'Image (S'Length), Both) & Item;

end "+"; </lang> This function can be used as follows: <lang ada>Put_Line (+"1"); Put_Line (+(+"1")); Put_Line (+(+(+"1"))); Put_Line (+(+(+(+"1")))); Put_Line (+(+(+(+(+"1"))))); Put_Line (+(+(+(+(+(+"1")))))); Put_Line (+(+(+(+(+(+(+"1"))))))); Put_Line (+(+(+(+(+(+(+(+"1")))))))); Put_Line (+(+(+(+(+(+(+(+(+"1"))))))))); Put_Line (+(+(+(+(+(+(+(+(+(+"1")))))))))); </lang> Sample output:

11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221

ALGOL 68

Translation of: Ada

Works with: ALGOL 68 version Standard - no extensions to language used

Works with: ALGOL 68G version Any - tested with release mk15-0.8b.fc9.i386

Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386

<lang algol>OP + = (STRING s)STRING: BEGIN

  CHAR item = s[LWB s];
  STRING out;
  FOR index FROM LWB s + 1 TO UPB s DO
     IF item /= s [index] THEN
        out := whole(index - LWB s, 0) + item + (+(s [index:UPB s]));
        GO TO return out
     FI
  OD;
  out := whole (UPB s, 0) + item;
  return out: out

END # + #;

OP + = (CHAR s)STRING:

 + STRING(s);

print ((+"1", new line)); print ((+(+"1"), new line)); print ((+(+(+"1")), new line)); print ((+(+(+(+"1"))), new line)); print ((+(+(+(+(+"1")))), new line)); print ((+(+(+(+(+(+"1"))))), new line)); print ((+(+(+(+(+(+(+"1")))))), new line)); print ((+(+(+(+(+(+(+(+"1"))))))), new line)); print ((+(+(+(+(+(+(+(+(+"1")))))))), new line)); print ((+(+(+(+(+(+(+(+(+(+"1"))))))))), new line))</lang> Output:

11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221

AWK

<lang awk>function lookandsay(a) {

 s = ""
 c = 1
 p = substr(a, 1, 1)
 for(i=2; i <= length(a); i++) {
   if ( p == substr(a, i, 1) ) {
     c++
   } else {
     s = s sprintf("%d%s", c, p)
     p = substr(a, i, 1)
     c = 1
   }
 }
 s = s sprintf("%d%s", c, p)
 return s

}

BEGIN {

 b = "1"
 print b
 for(k=1; k <= 10; k++) {
   b = lookandsay(b)
   print b
 }

}</lang>

C

There are no checks for memory allocation failure or "out of bound" in case more than the worst case happens.

<lang c>#include <stdio.h>

1. include <stdlib.h>
2. include <string.h>

char *lookandsay(const char *s) {

 int i, c, l, fi;
 char *r = NULL;
 char p;

 l = strlen(s);
 if ( l == 0 ) return NULL;
 r = malloc(l*3); /* worst case considered: each number gets a two digit counter */
 memset(r, 0, l*3);
 p = s[0];
 fi = 0;
 c = 1;
 for(i=1; i < l; i++) {
   if ( p == s[i] ) {
     c++;
   } else {
     fi += sprintf(&r[fi], "%d%c", c, p);
     c = 1;
     p = s[i];
   }
 }
 fi += sprintf(&r[fi], "%d%c", c, p);
 r[fi] = 0;
 free(s);
 return r;

}

int main() {

 int i;
 const char *laf = "1";

 printf("%s\n", laf);
 for(i=0; i < 10; i++) {
   laf = lookandsay(laf);
   printf("%s\n", laf);
 }
 free(laf);

 return 0;

}</lang>

C++

<lang cpp>#include <string>

1. include <sstream>

std::string lookandsay(const std::string &s) {

 std::ostringstream r;

 for (unsigned int i = 0; i != s.length(); ) {
   unsigned int new_i = s.find_first_not_of(s[i], i+1);
   if (new_i == std::string::npos)
     new_i = s.length();

   r << new_i - i << s[i];
   i = new_i;
 }
 return r.str();

}

1. include <iostream>

int main() {

 std::string laf = "1";

 std::cout << laf << std::endl;
 for (int i = 0; i < 10; i++) {
   laf = lookandsay(laf);
   std::cout << laf << std::endl;
 }

 return 0;

}</lang>

C#

<lang csharp>using System; using System.Text; using System.Linq;

class Program {

   static string lookandsay(string number)
   {
       StringBuilder result = new StringBuilder();

       char repeat = number[0];
       number = number.Substring(1, number.Length-1)+" ";
       int times = 1;
     
       foreach (char actual in number)
       {
           if (actual != repeat)
           {
               result.Append(Convert.ToString(times)+repeat);
               times = 1;
               repeat = actual;
           }
           else
           {
               times += 1;
           }
       }
       return result.ToString();
   }

   static void Main(string[] args)
   {
       string num = "1"; 

       foreach (int i in Enumerable.Range(1, 10)) {
            Console.WriteLine(num);
            num = lookandsay(num);             
       }
   }

}</lang>

Output:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

Common Lisp

<lang lisp>(defun compress (array &key (test 'eql) &aux (l (length array)))

 "Compresses array by returning a list of conses each of whose car is

a number of occurrences and whose cdr is the element occurring. For instance, (compress \"abb\") produces ((1 . #\a) (2 . #\b))."

 (if (zerop l) nil
   (do* ((i 1 (1+ i))
         (segments (acons 1 (aref array 0) '())))
        ((eql i l) (nreverse segments))
     (if (funcall test (aref array i) (cdar segments))
       (incf (caar segments))
       (setf segments (acons 1 (aref array i) segments))))))

(defun next-look-and-say (number)

 (reduce #'(lambda (n pair)
             (+ (* 100 n)
                (* 10 (car pair))
                (parse-integer (string (cdr pair)))))
         (compress (princ-to-string number))
         :initial-value 0))</lang>

Example use:

<lang lisp>(next-look-and-say 9887776666) ;=> 19283746</lang>

D

<lang d>import std.stdio; import std.string; void main() {

       char[]las = "1";
       writefln("%s",las);
       las = lookandsay(las);
       writefln("%s",las);
       las = lookandsay(las);
       writefln("%s",las);
       las = lookandsay(las);
       writefln("%s",las);
       las = lookandsay(las);
       writefln("%s",las);

}

char[]lookandsay(char[]input) {

       char last = input[$-1];
       char[]output;
       int count = 0;
       foreach_reverse(i;input) {
               if (i == last) {
                       count++;
               } else {
                       output = toString(count)~last~output;
                       count = 1;
                       last = i;
               }
       }
       output = toString(count)~last~output;
       return output;

} </lang>

E

<lang e>def lookAndSayNext(number :int) {

 var seen := null
 var count := 0
 var result := ""
 def put() {
   if (seen != null) {
     result += count.toString(10) + E.toString(seen)
   }
 }
 for ch in number.toString(10) {
   if (ch != seen) {
     put()
     seen := ch
     count := 0
   }
   count += 1
 }
 put()
 return __makeInt(result, 10)

}

var number := 1 for _ in 1..20 {

 println(number)
 number := lookAndSayNext(number)

}</lang>

Forth

<lang forth>create buf1 256 allot create buf2 256 allot buf1 value src buf2 value dest

s" 1" src place

append-run ( digit run -- )

 dest count +
 tuck c!  1+ c!
 dest c@ 2 + dest c! ;

next-look-and-say

 0 dest c!
 src 1+ c@  [char] 0  ( digit run )
 src count bounds do
   over i c@ =
   if   1+
   else append-run  i c@ [char] 1
   then
 loop
 append-run
 src dest to src to dest ;

look-and-say ( n -- )

 0 do next-look-and-say  cr src count type loop ;

10 look-and-say </lang>

Fortran

<lang fortran>module LookAndSay

 implicit none

contains

 subroutine look_and_say(in, out)
   character(len=*), intent(in) :: in
   character(len=*), intent(out) :: out

   integer :: i, c
   character(len=1) :: x
   character(len=2) :: d

   out = ""
   c = 1
   x = in(1:1)
   do i = 2, len(trim(in))
      if ( x == in(i:i) ) then
         c = c + 1
      else
         write(d, "(I2)") c
         out = trim(out) // trim(adjustl(d)) // trim(x)
         c = 1
         x = in(i:i)
      end if
   end do
   write(d, "(I2)") c
   out = trim(out) // trim(adjustl(d)) // trim(x)
 end subroutine look_and_say

end module LookAndSay</lang>

<lang fortran>program LookAndSayTest

 use LookAndSay
 implicit none

 integer :: i
 character(len=200) :: t, r
 t = "1"
 print *,trim(t)
 call look_and_say(t, r)
 print *, trim(r)
 do i = 1, 10
    call look_and_say(r, t)
    r = t
    print *, trim(r)
 end do

end program LookAndSayTest </lang>

Haskell

<lang haskell>import Control.Monad (liftM2) import Data.List (group)

-- this function is composed out of many functions; data flows from the bottom up lookAndSay :: Integer -> Integer lookAndSay = read -- convert digits to integer

          . concatMap                              -- concatenate for each run,
              (liftM2 (++) (show . length)         --    the length of it
                           (take 1))               --    and an example member
          . group                                  -- collect runs of the same digit
          . show                                   -- convert integer to digits

-- less comments lookAndSay2 :: Integer -> Integer lookAndSay2 = read . concatMap (liftM2 (++) (show . length)

                                           (take 1))
           . group . show

-- same thing with more variable names lookAndSay3 :: Integer -> Integer lookAndSay3 n = read (concatMap describe (group (show n)))

 where describe run = show (length run) ++ take 1 run

main = mapM_ print (iterate lookAndSay 1) -- display sequence until interrupted </lang>

J

Solution:

   las=.(,,@((#,{.);.1~1,2~:/\])&.(10x&#.^:_1)@:{:)@]^:[

Example:

   10 las 1
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221

Note the result is an actual numeric sequence (cf. the textual solutions given in other languages).

Java

Translation of: C#

Works with: Java version 1.5+

<lang java5>public static String lookandsay(String number){ StringBuilder result= new StringBuilder();

char repeat= number.charAt(0); number= number.substring(1) + " "; int times= 1;

for(char actual: number.toCharArray()){ if(actual != repeat){ result.append(times + "" + repeat); times= 1; repeat= actual; }else{ times+= 1; } } return result.toString(); }</lang> Testing: <lang java5>public static void main(String[] args){ String num = "1";

for (int i=1;i<=10;i++) { System.out.println(num); num = lookandsay(num); } }</lang> Output:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

JavaScript

Translation of: Perl

Works with: JavaScript version 1.6

<lang javascript>function lookandsay(str) {

   var next = "";
   str.match(/(.)\1*/g).forEach(function(seq){next += seq.length.toString() + seq[0]})
   return next;

}

var num = "1"; for (var i = 10; i > 0; i--) {

   print(num);
   num = lookandsay(num);

}</lang>

M4

Using regular expressions:

Translation of: Perl

<lang M4>divert(-1) define(`for',

  `ifelse($#,0,``$0,
  `ifelse(eval($2<=$3),1,
  `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')

define(`las',

  `patsubst(`$1',`\(\(.\)\2*\)',`len(\1)`'\2')')

define(`v',1) divert for(`x',1,10,

  `v

define(`v',las(v))')dnl v </lang>

Mathematica

Custom Functions: <lang Mathematica>RunLengthEncode[x_List]:=(Through[{First,Length}[#]]&)/@Split[x]

LookAndSay[n_,d_:1]:=NestList[Flatten[Reverse/@RunLengthEncode[#]]&,{d},n-1] </lang>

If second argument is omitted the sequence is started with 1. Second argument is supposed to be a digits from 0 to 9. If however a larger number is supplied it will be seen as 1 number, not multiple digits. However if one wants to start with a 2 or more digit number, one could reverse the sequence to go back to a single digit start. First example will create the first 13 numbers of the sequence starting with 1, the next example starts with 7: <lang Mathematica> FromDigits /@ LookAndSay[13] // Column

FromDigits /@ LookAndSay[13, 7] // Column </lang>

gives back:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221
3113112221232112111312211312113211
1321132132111213122112311311222113111221131221

7
17
1117
3117
132117
1113122117
311311222117
13211321322117
1113122113121113222117
31131122211311123113322117
132113213221133112132123222117
11131221131211132221232112111312111213322117
31131122211311123113321112131221123113111231121123222117 

MAXScript

fn lookAndSay num =
(
    local result = ""
    num += " "
    local current = num[1]
    local numReps = 1

    for digit in 2 to num.count do
    (
        if num[digit] != current then
        (
            result += (numReps as string) + current
            numReps = 1
            current = num[digit]
        )
        else
        (
            numReps += 1
        )
    )
    result
)

local num = "1"

for i in 1 to 10 do
(
    print num
    num = lookAndSay num
)

Metafont

<lang metafont>vardef lookandsay(expr s) = string r; r := ""; if string s:

 i := 0;
 forever: exitif not (i < length(s));
   c := i+1;
   forever: exitif ( (substring(c,c+1) of s) <> (substring(i,i+1) of s) );
     c := c + 1;
   endfor
   r := r & decimal (c-i) & substring(i,i+1) of s;
   i := c;
 endfor

fi r enddef;

string p; p := "1"; for el := 1 upto 10:

 message p;
 p := lookandsay(p);

endfor

end</lang>

Perl

<lang perl>sub lookandsay {

 my $str = shift;
 $str =~ s/((.)\2*)/length($1) . $2/ge;
 return $str;

}

my $num = "1"; foreach (1..10) {

 print "$num\n";
 $num = lookandsay($num);

}</lang>

PHP

<lang php><?php function lookandsay($str) {

 return preg_replace('/(.)\1*/e', 'strlen($0) . $1', $str);

}

$num = "1"; foreach (range(1,10) as $i) {

 echo "$num\n";
 $num = lookandsay($num);

} ?></lang>

PowerShell

<lang powershell>function Get-LookAndSay ($n = 1) {

   $re = [regex] '(.)\1*'
   $ret = ""
   foreach ($m in $re.Matches($n)) {
       $ret += [string] $m.Length + $m.Value[0]
   }
   return $ret

}

function Get-MultipleLookAndSay ($n) {

   if ($n -eq 0) {
       return @()
   } else {
       $a = 1
       $a
       for ($i = 1; $i -lt $n; $i++) {
           $a = Get-LookAndSay $a
           $a
       }
   }

}</lang> Output:

PS> Get-MultipleLookAndSay 8
1
11
21
1211
111221
312211
13112221
1113213211

Python

Translation of: C sharp – C#

<lang python>def lookandsay(number):

   result = ""

   repeat = number[0]
   number = number[1:]+" "
   times = 1

   for actual in number:
       if actual != repeat:
           result += str(times)+repeat
           times = 1
           repeat = actual
       else:
           times += 1

   return result

num = "1"

for i in range(10):

   print num
   num = lookandsay(num)</lang>

Functional

Works with: Python version 2.4+

<lang python>>>> from itertools import groupby >>> def lookandsay(number): return .join( str(len(list(g))) + k for k,g in groupby(number) )

>>> numberstring='1' >>> for i in range(10): print numberstring numberstring = lookandsay(numberstring)</lang>

Output:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

Using regular expressions:

Translation of: Perl

<lang python>import re

def foo(match):

   return str(len(match.group(0))) + match.group(1)

def lookandsay(str):

   return re.sub(r'(.)\1*', foo, str)

num = "1" for i in range(10):

   print num
   num = lookandsay(num)</lang>

R

Returning the value as an integer limits how long the sequence can get, so the option for integer or character return values are provided. <lang R>look.and.say <- function(x, return.an.int=FALSE) {

  #convert number to character vector
  xstr <- unlist(strsplit(as.character(x), ""))
  #get run length encoding   
  rlex <- rle(xstr)
  #form new string
  odds <- as.character(rlex$lengths)
  evens <- rlex$values
  newstr <- as.vector(rbind(odds, evens))
  #collapse to scalar
  newstr <- paste(newstr, collapse="")
  #convert to number, if desired
  if(return.an.int) as.integer(newstr) else newstr

} </lang> Example usage. <lang R>x <- 1 for(i in 1:10) {

  x <- look.and.say(x)
  print(x)

} </lang>

Ruby

Translation of: Perl

<lang ruby>def lookandsay(str)

  str.gsub(/(.)\1*/) {$&.length.to_s + $1}

end

num = "1" 10.times do

   puts num
   num = lookandsay(num)

end</lang>

Smalltalk

Works with: GNU Smalltalk

<lang smalltalk>String extend [

 lookAndSay [ |anElement nextElement counter coll newColl|
    coll := (self asOrderedCollection).
    newColl := OrderedCollection new.
    counter := 0.
    anElement := (coll first).
    [ coll size > 0 ]
    whileTrue: [
       nextElement := coll removeFirst.

( anElement == nextElement ) ifTrue: [

          counter := counter + 1.
       ] ifFalse: [

newColl add: (counter displayString). newColl add: (anElement asString). anElement := nextElement. counter := 1.

       ]
    ].
    newColl add: (counter displayString).
    newColl add: (anElement asString).
    ^(newColl join)
 ]

].

|r| r := '1'. 10 timesRepeat: [

 r displayNl.
 r := r lookAndSay.

]</lang>

Tcl

<lang tcl>proc lookandsay n {

   set new ""
   while {[string length $n] > 0} {
       set char [string index $n 0]
       for {set count 1} {[string index $n $count] eq $char} {incr count} {}
       append new $count $char
       set n [string range $n $count end]
   }
   interp alias {} next_lookandsay {} lookandsay $new
   return $new

}

puts 1  ;# ==> 1 puts [lookandsay 1]  ;# ==> 11 puts [next_lookandsay] ;# ==> 21 puts [next_lookandsay] ;# ==> 1211 puts [next_lookandsay] ;# ==> 111221 puts [next_lookandsay] ;# ==> 312211</lang>

Ursala

The look_and_say function returns the first n results by iterating the function that maps a given sequence to its successor. <lang Ursala>#import std

1. import nat

look_and_say "n" = ~&H\'1' next"n" rlc~&E; *= ^lhPrT\~&hNC %nP+ length

1. show+

main = look_and_say 10</lang> output:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

Vedit macro language

This implementation generates look-and-say sequence starting from the sequence on cursor line in edit buffer. Each new sequence is inserted as a new line. 10 sequences are created in this example.

<lang vedit>Repeat(10) {

 BOL
 Reg_Empty(20)
 While (!At_EOL) {
   Match("(.)\1*", REGEXP+ADVANCE)
   Num_Str(Chars_Matched, 20, LEFT+APPEND)
   Reg_Copy_Block(20, CP-1, CP, APPEND)
 }
 Ins_Newline Reg_Ins(20)

} </lang>

Output:

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221