Look-and-say sequence

From Rosetta Code

Jump to: navigation, search
Task
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.

[edit] See also

Contents


[edit] 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 "+";

This function can be used as follows: 

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

Sample output: 

11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221

[edit] 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 

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

Output: 

11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221

[edit] AutoHotkey

AutoExecute:
    Gui, -MinimizeBox
    Gui, Add, Edit, w500 r20 vInput, 1
    Gui, Add, Button, x155 w100 Default, &Calculate
    Gui, Add, Button, xp+110 yp wp, E&xit
    Gui, Show,, Look-and-Say sequence
Return
 
 
ButtonCalculate:
    Gui, Submit, NoHide
    GuiControl,, Input, % LookAndSay(Input)
Return
 
 
GuiClose:
ButtonExit:
    ExitApp
Return
 
 
;---------------------------------------------------------------------------
LookAndSay(Input) {
;--------------------------------------------------------------------------- 
    ; credit for this function goes to AutoHotkey forum member Laslo 
    ; http://www.autohotkey.com/forum/topic44657-161.html
    ;-----------------------------------------------------------------------
    Loop, Parse, Input          ; look at every digit
        If (A_LoopField = d)    ; I've got another one! (of the same value)
            c += 1                  ; Let's count them ...
        Else {                  ; No, this one is different!
            r .= c d                ; remember what we've got so far
            c := 1                  ; It is the first one in a row
            d := A_LoopField        ; Which one is it?
        }
    Return, r c d
}

[edit] 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
  }
}

[edit] C

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

#include <stdio.h>
#include <stdlib.h>
#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;
}

[edit] C++

#include <string>
#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();
}
 
#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;
}

[edit] C#

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

Output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

[edit] Common 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))

Example use: 

(next-look-and-say 9887776666) ;=> 19283746

[edit] 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;
}

[edit] 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)
}

[edit] Erlang

-module(str).
-export([look_and_say/1, look_and_say/2]).
 
%% converts a single number
look_and_say([H|T]) -> lists:reverse(look_and_say(T,H,1,"")).
 
%% converts and accumulates as a loop
look_and_say(_, 0) -> [];
look_and_say(Start, Times) when Times > 0 ->
    [Start | look_and_say(look_and_say(Start), Times-1)].
 
%% does the actual conversion for a number
look_and_say([], Current, N, Acc) ->
    [Current, $0+N | Acc];
look_and_say([H|T], H, N, Acc) ->
    look_and_say(T, H, N+1, Acc);
look_and_say([H|T], Current, N, Acc) ->
    look_and_say(T, H, 1, [Current, $0+N | Acc]).

output: 

1> c(str).
{ok,str}
2> str:look_and_say("1").
"11"
3> str:look_and_say("111221").
"312211"
4> str:look_and_say("1",10).
["1","11","21","1211","111221","312211","13112221",
 "1113213211","31131211131221","13211311123113112211"]

[edit] Factor

: (look-and-say) ( str -- )
    unclip-slice swap [ 1 ] 2dip [
        2dup = [ drop [ 1 + ] dip ] [
            [ [ number>string % ] dip , 1 ] dip
        ] if
    ] each [ number>string % ] [ , ] bi* ;
 
: look-and-say ( str -- str' ) [ (look-and-say) ] "" make ;
 
"1" 10 [ dup print look-and-say ] times print

[edit] 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

[edit] 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
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

[edit] 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

[edit] HaXe

package ;
 
import neko.Lib;
 
using Std;
 
class Main 
{
 
	static function main() 
	{
		var test = "1";
		for (i in 0...11) {
			Lib.println(test);
			test = lookAndSay(test);
		}
	}
 
	static function lookAndSay(s:String)
	{
		if (s == null || s == "") return "";
 
		var results = "";
		var repeat = s.charAt(0);
		var amount = 1;
		for (i in 1...s.length)
		{
			var actual = s.charAt(i);
			if (actual != repeat)
			{
				results += amount.string();
				results += repeat;
				repeat = actual;
				amount = 0;
			}
			amount++;
		}
		results += amount.string();
		results += repeat;
 
		return results;
	}
}

[edit] 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).

[edit] Java

Translation of: C#

Works with: Java version 1.5+ 

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

Testing: 

public static void main(String[] args){
	String num = "1"; 
 
	for (int i=1;i<=10;i++) {
		System.out.println(num);
		num = lookandsay(num);             
	}
}

Output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

[edit] JavaScript

Translation of: Perl 

function lookandsay(str) {
    return str.replace(/(.)\1*/g, function(seq, p1){return seq.length.toString() + p1})
}
 
var num = "1";
for (var i = 10; i > 0; i--) {
    alert(num);
    num = lookandsay(num);
}

[edit] Logo

to look.and.say.loop :in :run :c :out
  if empty? :in [output (word :out :run :c)]
  if equal? first :in :c [output look.and.say.loop bf :in :run+1 :c :out]
  output look.and.say.loop bf :in 1 first :in (word :out :run :c)
end
to look.and.say :in
  if empty? :in [output :in]
  output look.and.say.loop bf :in 1 first :in "||
end
 
show cascade 10 [print ? look.and.say ?] 1

[edit] Lua

 
--returns an iterator over the first n copies of the look-and-say sequence
function lookandsayseq(n)
  local t = {1}
  return function()
    local ret = {}
    for i, v in ipairs(t) do
      if t[i-1] and v == t[i-1] then
        ret[#ret - 1] = ret[#ret - 1] + 1
      else
        ret[#ret + 1] = 1
        ret[#ret + 1] = v
      end
    end
    t = ret
    n = n - 1
    if n > 0 then return table.concat(ret) end
  end
end
for i in lookandsayseq(10) do print(i) end
 

Alternative solution, using LPeg: 

 
require "lpeg"
local P, C, Cf, Cc = lpeg.P, lpeg.C, lpeg.Cf, lpeg.Cc
lookandsay = Cf(Cc"" * C(P"1"^1 + P"2"^1 + P"3"^1)^1, function (a, b) return a .. #b .. string.sub(b,1,1) end)
t = "1"
for i = 1, 10 do
  print(t)
  t = lookandsay:match(t)
end
 

[edit] M4

Using regular expressions: Translation of: Perl 

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

[edit] Mathematica

Custom Functions: 

RunLengthEncode[x_List]:=(Through[{First,Length}[#]]&)/@Split[x]
 LookAndSay[n_,d_:1]:=NestList[Flatten[Reverse/@RunLengthEncode[#]]&,{d},n-1]

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: 

FromDigits /@ LookAndSay[13] // Column
FromDigits /@ LookAndSay[13, 7] // Column

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

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

[edit] 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

[edit] OCaml

let aux s =
  let len = String.length s in
  let rec aux c i n acc =
    if i >= len
    then List.rev((n,c)::acc)
    else
      if c = s.[i]
      then aux c (succ i) (succ n) acc
      else aux s.[i] (succ i) 1 ((n,c)::acc)
  in
  aux s.[0] 1 1 []
 
let lookandsay num =
  let l = aux num in
  let s =
    List.map (fun (n,c) ->
                (string_of_int n) ^ (String.make 1 c)) l
  in
  String.concat "" s
 
let fold_loop f ini n =
  let rec aux i acc =
    if i >= n
    then (acc)
    else aux (succ i) (f acc i)
  in
  aux 0 ini
 
let _ =
  fold_loop
    (fun num _ ->
       let next = lookandsay num in
       print_endline next;
       (next))
    (string_of_int 1) 10

Alternately, using the included Str library: 

#load "str.cma";;
 
let lookandsay =
  Str.global_substitute (Str.regexp "\\(.\\)\\1*")
                        (fun s -> string_of_int (String.length (Str.matched_string s)) ^
                                  Str.matched_group 1 s)
 
let () =
  let num = ref "1" in
  print_endline !num;
  for i = 1 to 10 do
    num := lookandsay !num;
    print_endline !num;
  done

Another solution using the pcre bindings: 

open Pcre
 
let lookandsay str =
  let rex = regexp "(.)\\1*" in
  let subs = exec_all ~rex str in
  let ar = Array.map (fun sub -> get_substring sub 0) subs in
  let ar = Array.map (fun s -> String.length s, s.[0]) ar in
  let ar = Array.map (fun (n,c) -> (string_of_int n) ^ (String.make 1 c)) ar in
  let res = String.concat "" (Array.to_list ar) in
  (res)
 
let () =
  let num = ref(string_of_int 1) in
  for i = 1 to 10 do
    num := lookandsay !num;
    print_endline !num;
  done

run this example with 'ocaml -I +pcre pcre.cma script.ml'

[edit] Oz

declare
  %% e.g. "21" -> "1211"
  fun {LookAndSayString S}
     for DigitGroup in {Group S} append:Add do
        {Add {Int.toString {Length DigitGroup}}}
        {Add [DigitGroup.1]}
     end
  end
 
  %% lazy sequence of integers starting with N
  fun {LookAndSay N}
     fun lazy {Loop S}
        {String.toInt S}|{Loop {LookAndSayString S}}
     end
  in
     {Loop {Int.toString N}}
  end
 
  %% like Haskell's "group"
  fun {Group Xs}
     case Xs of nil then nil
     [] X|Xr then
	Ys Zs
        {List.takeDropWhile Xr fun {$ W} W==X end ?Ys ?Zs}
     in
        (X|Ys) | {Group Zs}
     end
  end
in
  {ForAll {List.take {LookAndSay 1} 10} Show}

[edit] 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);
}

[edit] 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);
}
?>

[edit] PicoLisp

(de las (Str)
   (pack
      (make
         (for (Lst (chop Str) Lst)
            (let (N 1  C)
               (while (= (setq C (pop 'Lst)) (car Lst))
                  (inc 'N) )
               (link (format N) C) ) ) ) ) )

Usage: 

: (las "1")
-> "11"
: (las @)
-> "21"
: (las @)
-> "1211"
: (las @)
-> "111221"
: (las @)
-> "312211"
: (las @)
-> "13112221"
: (las @)
-> "1113213211"
: (las @)
-> "31131211131221"

[edit] PowerBASIC

This uses the RLEncode function from the PowerBASIC Run-length encoding entry. 

FUNCTION RLEncode (i AS STRING) AS STRING
    DIM tmp1 AS STRING, tmp2 AS STRING, outP AS STRING
    DIM Loop0 AS LONG, count AS LONG
 
    FOR Loop0 = 1 TO LEN(i)
        tmp1 = MID$(i, Loop0, 1)
        IF tmp1 <> tmp2 THEN
            IF count > 1 THEN
                outP = outP & TRIM$(STR$(count)) & tmp2
                tmp2 = tmp1
                count = 1
            ELSEIF 0 = count THEN
                tmp2 = tmp1
                count = 1
            ELSE
                outP = outP & "1" & tmp2
                tmp2 = tmp1
            END IF
        ELSE
            INCR count
        END IF
    NEXT
 
    outP = outP & TRIM$(STR$(count)) & tmp2
    FUNCTION = outP
END FUNCTION
 
FUNCTION lookAndSay(BYVAL count AS LONG) AS STRING
    DIM iii AS STRING, tmp AS STRING
 
    IF count > 1 THEN
        iii = lookAndSay(count - 1)
    ELSEIF count < 2 THEN
        iii = "1"
    END IF
 
    tmp = RLEncode(iii)
    lookAndSay = tmp
END FUNCTION
 
FUNCTION PBMAIN () AS LONG
    DIM v AS LONG
    v = VAL(INPUTBOX$("Enter a number."))
    MSGBOX lookAndSay(v)
END FUNCTION

[edit] 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
        }
    }
}

Output: 

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

[edit] PureBasic

If OpenConsole()
  Define i, j, cnt, txt$, curr$, result$
  Print("Enter start sequence: "): txt$=Input()
  Print("How many repetitions: "): i=Val(Input())
  ;
  PrintN(#CRLF$+"Sequence:"+#CRLF$+txt$)
  Repeat
    j=1
    result$=""
    Repeat
      curr$=Mid(txt$,j,1)
      cnt=0
      Repeat
        cnt+1
        j+1
      Until Mid(txt$,j,1)<>curr$
      result$+Str(cnt)+curr$
    Until j>Len(txt$)    
    PrintN(result$)
    txt$=result$
    i-1
  Until i<=0
  ;
  PrintN(#CRLF$+"Press ENTER to exit."): Input()
  CloseConsole()
EndIf

Output 

Enter start sequence: 1
How many repetitions: 7

Sequence:
1
11
21
1211
111221
312211
13112221
1113213211

[edit] Python

Translation of: C sharp 

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)

Functional Works with: Python version 2.4+ 

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

Output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

Using regular expressions: Translation of: Perl 

import re
 
def lookandsay(str):
    return re.sub(r'(.)\1*', lambda m: str(len(m.group(0))) + m.group(1), str)
 
num = "1"
for i in range(10):
    print num
    num = lookandsay(num)

[edit] 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. 

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
}

Example usage. 

x <- 1
for(i in 1:10)
{
   x <- look.and.say(x)
   print(x)
}

[edit] Ruby

Translation of: Perl 

def lookandsay(str)
   str.gsub(/(.)\1*/) {$&.length.to_s + $1}
end
 
num = "1"
10.times do
    puts num
    num = lookandsay(num)
end

[edit] Scala

def lookAndSay(seed: BigInt) = {
  val s = seed.toString
  ( 1 until s.size).foldLeft((1, s(0), new StringBuilder)) {
    case ((len, c, sb), index) if c != s(index) => sb.append(len); sb.append(c); (1, s(index), sb)
    case ((len, c, sb), _) => (len + 1, c, sb)
  } match {
    case (len, c, sb) => sb.append(len); sb.append(c); BigInt(sb.toString)
  }
}
 
def lookAndSayIterator(seed: BigInt) = Iterator.iterate(seed)(lookAndSay)

[edit] Smalltalk

Works with: GNU 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.
]

[edit] SNOBOL4

Works with: Macro Spitbol Works with: Snobol4+ Works with: CSnobol

The look-and-say sequence is an iterative run-length string encoding. So looksay( ) is just a wrapper around the Run-length Encoding task. This is by far the easiest solution. 

*       # Encode RLE
        define('rle(str)c,n') :(rle_end)
rle     str len(1) . c :f(return)
        str span(c) @n =
        rle = rle n c :(rle)
rle_end
 
*       # First m members of sequence with seed n 
        define('looksay(n,m)') :(looksay_end)
looksay output = n; m = gt(m,1) m - 1 :f(return)
        n = rle(n) :(looksay)
looksay_end        
 
*       Test and display        
        looksay(1,10)
end

Output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211

[edit] SQL

DROP VIEW delta;
CREATE VIEW delta AS
    SELECT sequence1.v AS x,
           (sequence1.v<>sequence2.v)*sequence1.c AS v,
           sequence1.c AS c
      FROM SEQUENCE AS sequence1,
           SEQUENCE AS sequence2
     WHERE sequence1.c = sequence2.c+1;
 
DROP VIEW rle0;
CREATE VIEW rle0 AS
    SELECT delta2.x AS x,
           SUM(delta2.v) AS v,
           delta2.c AS c
      FROM delta AS delta1,
           delta AS delta2
     WHERE delta1.c >= delta2.c
  GROUP BY delta1.c;
 
DROP VIEW rle1;
CREATE VIEW rle1 AS
    SELECT SUM(x)/x AS a,
           x AS b,
           c AS c
      FROM rle0
  GROUP BY v;
 
DROP VIEW rle2;
CREATE VIEW rle2 AS
    SELECT a AS v, 1 AS o, 2*c+0 AS c FROM rle1 UNION
    SELECT b AS v, 1 AS o, 2*c+1 AS c FROM rle1;
 
DROP VIEW normed;
CREATE VIEW normed AS
    SELECT r1.v AS v, SUM(r2.o) AS c
      FROM rle2 AS r1,
           rle2 AS r2
     WHERE r1.c >= r2.c
  GROUP BY r1.c;
 
DROP TABLE rle;
CREATE TABLE rle(v INT, c INT);
INSERT INTO rle SELECT * FROM normed ORDER BY c;
 
DELETE FROM SEQUENCE;
INSERT INTO SEQUENCE VALUES(-1,0);
INSERT INTO SEQUENCE SELECT * FROM rle;

Usage: 

% sqlite3 
SQLite version 3.4.0
Enter ".help" for instructions
sqlite> CREATE TABLE sequence(v int, c int);
sqlite> INSERT INTO sequence VALUES(-1,0);
sqlite> INSERT INTO sequence VALUES(1,1);
sqlite> SELECT * FROM sequence;
-1|0
1|1
sqlite> .read look.sql
sqlite> SELECT * FROM sequence;
-1|0
1|1
1|2
sqlite> .read look.sql
sqlite> SELECT * FROM sequence;
-1|0
2|1
1|2
sqlite> .read look.sql
sqlite> SELECT * FROM sequence;
-1|0
1|1
2|2
1|3
1|4
sqlite> .read look.sql
sqlite> SELECT * FROM sequence;
-1|0
1|1
1|2
1|3
2|4
2|5
1|6

[edit] 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

[edit] Ursala

The look_and_say function returns the first n results by iterating the function that maps a given sequence to its successor. 

#import std
#import nat
 
look_and_say "n" = ~&H\'1' next"n" rlc~&E; *= ^lhPrT\~&hNC %nP+ length
 
#show+
 
main = look_and_say 10

output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211


[edit] 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. 

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

Output: 

1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221

[edit] VBScript

[edit] Implementation
 
function looksay( n )
	dim i
	dim accum
	dim res
	dim c
	res = vbnullstring
	do
		if n = vbnullstring then exit do
		accum = 0
		c = left( n,1 )
		do while left( n, 1 ) = c
			accum = accum + 1
			n = mid(n,2)
		loop
		if accum > 0 then 
			res = res & accum & c
		end if
	loop
	looksay = res
end function
 
 
[edit] Invocation
 
dim m 
m = 1
for i = 0 to 13
	m = looksay(m)
	wscript.echo m
next
 
[edit] Output
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211
11131221133112132113212221
3113112221232112111312211312113211
1321132132111213122112311311222113111221131221
11131221131211131231121113112221121321132132211331222113112211
311311222113111231131112132112311321322112111312211312111322212311322113212221
Retrieved from "http://rosettacode.org/wiki/Look-and-say_sequence"
Personal tools