Look-and-say sequence: Difference between revisions
m (order) |
|||
| Line 1,284: | Line 1,284: | ||
end</lang> |
end</lang> |
||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
| Line 1,404: | Line 1,428: | ||
(* see http://oeis.org/A005341 *)</lang> |
(* see http://oeis.org/A005341 *)</lang> |
||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
=={{header|Oz}}== |
=={{header|Oz}}== |
||
Revision as of 16:44, 16 November 2013
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
Task description
- Write a program to generate successive members of the look-and-say sequence.
See also
- This task is related to, and an application of, the Run-length encoding task.
- Sequence A005150 on The On-Line Encyclopedia of Integer Sequences.
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
<lang algol68>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
AutoHotkey
<lang 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
}</lang>
APL
<lang apl>
⎕IO←0
d←{(1↓⍵)-¯1↓⍵}
f←{m←(0≠d ⍵),1 ⋄ ,(d ¯1,m/⍳⍴⍵),[.5](m/⍵)}
{(f⍣⍵) ,1}¨⍳10
</lang>
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>
BBC BASIC
<lang bbcbasic> number$ = "1"
FOR i% = 1 TO 10
number$ = FNlooksay(number$)
PRINT number$
NEXT
END
DEF FNlooksay(n$)
LOCAL i%, j%, c$, o$
i% = 1
REPEAT
c$ = MID$(n$,i%,1)
j% = i% + 1
WHILE MID$(n$,j%,1) = c$
j% += 1
ENDWHILE
o$ += STR$(j%-i%) + c$
i% = j%
UNTIL i% > LEN(n$)
= o$</lang>
Output:
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221
C
This program will not stop until killed or running out of memory. <lang c>#include <stdio.h>
- include <stdlib.h>
int main() { char *a = malloc(2), *b = 0, *x, c; int cnt, len = 1;
for (sprintf(a, "1"); (b = realloc(b, len * 2 + 1)); a = b, b = x) { puts(x = a); for (len = 0, cnt = 1; (c = *a); ) { if (c == *++a) cnt++; else if (c) { len += sprintf(b + len, "%d%c", cnt, c); cnt = 1; } } }
return 0; }</lang>
C++
<lang cpp>#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;
}</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
Alternate version using Regex (C#2 syntax only): <lang csharp> using System; using System.Text.RegularExpressions;
namespace RosettaCode_Cs_LookAndSay {
public class Program
{
public static int Main(string[] args)
{
Array.Resize<string>(ref args, 2);
string ls = args[0] ?? "1";
int n;
if (!int.TryParse(args[1], out n)) n = 10;
do {
Console.WriteLine(ls);
if (--n <= 0) break;
ls = say(look(ls));
} while(true);
return 0;
}
public static string[] look(string input)
{
int i = -1;
return Array.FindAll(Regex.Split(input, @"((\d)\2*)"),
delegate(string p) { ++i; i %= 3; return i == 1; }
);
}
public static string say(string[] groups)
{
return string.Concat(
Array.ConvertAll<string, string>(groups,
delegate(string p) { return string.Concat(p.Length, p[0]); }
)
);
}
}
}</lang> Output (with args: 1 15):
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221
Clojure
No ugly int-to-string-and-back conversions.
<lang clojure>(defn digits-seq
"Returns a seq of the digits of a number (L->R)."
[n]
(loop [digits (), number n]
(if (zero? number) (seq digits)
(recur (cons (mod number 10) digits)
(quot number 10)))))
(defn join-digits
"Converts a digits-seq back in to a number." [ds] (reduce (fn [n d] (+ (* 10 n) d)) ds))
(defn look-and-say [n]
(->> n digits-seq (partition-by identity)
(mapcat (juxt count first)) join-digits))</lang>
Example output: <lang clojure>user> (take 8 (iterate look-and-say 1)) (1 11 21 1211 111221 312211 13112221 1113213211)</lang>
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>
Straight character counting: <lang lisp>(defun look-and-say (s)
(let ((out (list (char s 0) 0)))
(loop for x across s do
(if (char= x (first out)) (incf (second out)) (setf out (list* x 1 out))))
(format nil "~{~a~^~}" (nreverse out))))
(loop for s = "1" then (look-and-say s)
repeat 10
do (write-line s))</lang>
D
Short Functional Version
<lang d>import std.stdio, std.algorithm, std.range;
enum say = (in string s) pure => s.group.map!q{ text(a[1],a[0]) }.join;
void main() {
"1".recurrence!((t, n) => t[n - 1].say).take(8).writeln;
}</lang>
- Output:
["1", "11", "21", "1211", "111221", "312211", "13112221", "1113213211"]
Fast Imperative Version
Same output. <lang d>import core.stdc.stdio, std.math, std.conv, std.algorithm, std.array;
void showLookAndSay(bool showArrays)(in uint n) nothrow {
if (n == 0) // No sequences to generate and show.
return;
enum Digit : char { nil = '\0', one = '1', two = '2', thr = '3' }
// Allocate an approximate upper bound size for the array.
static Digit* allocBuffer(in uint m) nothrow {
immutable len = cast(size_t)(100 + 1.05 *
exp(0.269 * m + 0.2686)) + 1;
auto a = len.uninitializedArray!(Digit[]);
printf("Allocated %d bytes.\n", a.length * Digit.sizeof);
return a.ptr;
}
// Can't be expressed in the D type system:
// a1 and a2 are immutable pointers to mutable data.
auto a1 = allocBuffer(n % 2 ? n : n - 1);
auto a2 = allocBuffer(n % 2 ? n - 1 : n);
printf("\n");
a1[0] = Digit.one; size_t len1 = 1; a1[len1] = Digit.nil;
foreach (immutable i; 0 .. n - 1) {
static if (showArrays)
printf("%2u: %s\n", i + 1, a1);
else
printf("%2u: n. digits: %u\n", i + 1, len1);
auto p1 = a1,
p2 = a2;
S0: final switch (*p1++) with (Digit) { // Initial state.
case nil: goto END;
case one: goto S1;
case two: goto S2;
case thr: goto S3;
}
S1: final switch (*p1++) with (Digit) {
case nil: *p2++ = one; *p2++ = one; goto END;
case one: goto S11;
case two: *p2++ = one; *p2++ = one; goto S2;
case thr: *p2++ = one; *p2++ = one; goto S3;
}
S2: final switch (*p1++) with (Digit) {
case nil: *p2++ = one; *p2++ = two; goto END;
case one: *p2++ = one; *p2++ = two; goto S1;
case two: goto S22;
case thr: *p2++ = one; *p2++ = two; goto S3;
}
S3: final switch (*p1++) with (Digit) {
case nil: *p2++ = one; *p2++ = thr; goto END;
case one: *p2++ = one; *p2++ = thr; goto S1;
case two: *p2++ = one; *p2++ = thr; goto S2;
case thr: goto S33;
}
S11: final switch (*p1++) with (Digit) {
case nil: *p2++ = two; *p2++ = one; goto END;
case one: *p2++ = thr; *p2++ = one; goto S0;
case two: *p2++ = two; *p2++ = one; goto S2;
case thr: *p2++ = two; *p2++ = one; goto S3;
}
S22: final switch (*p1++) with (Digit) {
case nil: *p2++ = two; *p2++ = two; goto END;
case one: *p2++ = two; *p2++ = two; goto S1;
case two: *p2++ = thr; *p2++ = two; goto S0;
case thr: *p2++ = two; *p2++ = two; goto S3;
}
S33: final switch (*p1++) with (Digit) {
case nil: *p2++ = two; *p2++ = thr; goto END;
case one: *p2++ = two; *p2++ = thr; goto S1;
case two: *p2++ = two; *p2++ = thr; goto S2;
case thr: *p2++ = thr; *p2++ = thr; goto S0;
}
END:
immutable len2 = p2 - a2;
a2[len2] = Digit.nil;
a1.swap(a2);
len1 = len2;
}
static if (showArrays)
printf("%2u: %s\n", n, a1);
else
printf("%2u: n. digits: %u\n", n, len1);
}
void main(in string[] args) {
immutable n = (args.length == 2) ? args[1].to!uint : 10; n.showLookAndSay!true;
}</lang>
- Output:
Allocated 116 bytes. Allocated 121 bytes. 1: 1 2: 11 3: 21 4: 1211 5: 111221 6: 312211 7: 13112221 8: 1113213211 9: 31131211131221 10: 13211311123113112211
With: <lang d>70.showLookAndSay!false;</lang>
- Output:
Allocated 158045069 bytes. Allocated 206826462 bytes. 1: n. digits: 1 2: n. digits: 2 3: n. digits: 2 4: n. digits: 4 5: n. digits: 6 ... 60: n. digits: 12680852 61: n. digits: 16530884 62: n. digits: 21549544 63: n. digits: 28091184 64: n. digits: 36619162 65: n. digits: 47736936 66: n. digits: 62226614 67: n. digits: 81117366 68: n. digits: 105745224 69: n. digits: 137842560 70: n. digits: 179691598
Using the LDC2 compiler with n=70 the run-time is about 3.74 seconds.
Intermediate Version
This mostly imperative version is intermediate in both speed and code size: <lang d>void main(in string[] args) {
import std.stdio, std.conv, std.algorithm, std.array, std.string;
immutable n = (args.length == 2) ? args[1].to!uint : 10;
if (n == 0)
return;
auto seq = ['1'];
writefln("%2d: n. digits: %d", 1, seq.length);
foreach (immutable i; 2 .. n + 1) {
Appender!(typeof(seq)) result;
foreach (const digit, const count; seq.representation.group) {
result ~= "123"[count - 1];
result ~= digit;
}
seq = result.data;
writefln("%2d: n. digits: %d", i, seq.length);
}
}</lang> The output is the same as the second version.
If you modify the first program to print only the lengths of the strings (with a .map!(s => s.length)), compiling with LDC2 the run-times of the three versions with n=55 are about 31.1, 0.10 and 0.23 seconds.
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>
Erlang
<lang 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]).</lang>
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"]
Factor
<lang 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</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>
GAP
<lang gap>LookAndSay := function(s)
local c, r, cur, ncur, v;
v := "123";
r := "";
cur := 0;
ncur := 0;
for c in s do
if c = cur then
ncur := ncur + 1;
else
if ncur > 0 then
Add(r, v[ncur]);
Add(r, cur);
fi;
cur := c;
ncur := 1;
fi;
od;
Add(r, v[ncur]);
Add(r, cur);
return r;
end;
LookAndSay("1"); # "11" LookAndSay(last); # "21" LookAndSay(last); # "1211" LookAndSay(last); # "111221" LookAndSay(last); # "312211" LookAndSay(last); # "13112221" LookAndSay(last); # "1113213211" LookAndSay(last); # "31131211131221" LookAndSay(last); # "13211311123113112211" LookAndSay(last); # "11131221133112132113212221" LookAndSay(last); # "3113112221232112111312211312113211" LookAndSay(last); # "1321132132111213122112311311222113111221131221" LookAndSay(last); # "11131221131211131231121113112221121321132132211331222113112211" LookAndSay(last); # "311311222113111231131112132112311321322112111312211312111322212311322113212221"</lang>
Go
<lang go>package main
import (
"fmt" "strconv"
)
func lss(s string) (r string) {
c := s[0]
nc := 1
for i := 1; i < len(s); i++ {
d := s[i]
if d == c {
nc++
continue
}
r += strconv.Itoa(nc) + string(c)
c = d
nc = 1
}
return r + strconv.Itoa(nc) + string(c)
}
func main() {
s := "1"
fmt.Println(s)
for i := 0; i < 8; i++ {
s = lss(s)
fmt.Println(s)
}
}</lang> Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221
Groovy
<lang groovy>def lookAndSay(sequence) {
def encoded = new StringBuilder()
(sequence.toString() =~ /(([0-9])\2*)/).each { matcher ->
encoded.append(matcher[1].size()).append(matcher[2])
}
encoded.toString()
}</lang> Test Code <lang groovy>def sequence = "1" (1..12).each {
println sequence sequence = lookAndSay(sequence)
}</lang> Output
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211
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>
Haxe
<lang haxe>using Std;
class Main {
static function main() { var test = "1"; for (i in 0...11) { Sys.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; } }</lang>
Icon and Unicon
<lang Icon>procedure main() every 1 to 10 do
write(n := nextlooknsayseq(\n | 1))
end
procedure nextlooknsayseq(n) #: return next element in look and say sequence n2 := "" n ? until pos(0) do {
i := tab(any(&digits)) | fail # or fail if not digits move(-1) n2 ||:= *tab(many(i)) || i # accumulate count+digit }
return n2 end</lang>
Output:
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221
J
Solution:
<lang j>las=: ,@((# , {.);.1~ 1 , 2 ~:/\ ])&.(10x&#.inv)@]^:(1+i.@[)</lang>
Example: <lang j> 10 las 1 1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221</lang>
Note the result is an actual numeric sequence (cf. the textual solutions given in other languages).
Java
<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
<lang javascript>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);
}</lang>
K
<lang k> las: {x{0$,//$(#:'n),'*:'n:(&1,~=':x)_ x:0$'$x}\1}
las 8
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221</lang>
Lasso
The Look-and-say sequence is a recursive RLE, so the solution can leverage the same method as used for RLE. <lang Lasso>define rle(str::string)::string => { local(orig = #str->values->asCopy,newi=array, newc=array, compiled=string) while(#orig->size) => { if(not #newi->size) => { #newi->insert(1) #newc->insert(#orig->first) #orig->remove(1) else if(#orig->first == #newc->last) => { #newi->get(#newi->size) += 1 else #newi->insert(1) #newc->insert(#orig->first) } #orig->remove(1) } } loop(#newi->size) => { #compiled->append(#newi->get(loop_count)+#newc->get(loop_count)) } return #compiled } define las(n::integer,run::integer) => { local(str = #n->asString) loop(#run) => { #str = rle(#str) } return #str } loop(15) => {^ las(1,loop_count) + '\r' ^}</lang>
- Output:
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221 132113213221133112132113311211131221121321131211132221123113112221131112311332111213211322211312113211
Logo
<lang 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</lang>
Lua
<lang 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</lang>
Alternative solution, using LPeg: <lang lua>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</lang>
M4
Using regular expressions:
<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
Maxima
<lang maxima>collect(a) := block(
[n: length(a), b: [ ], x: a[1], m: 1],
for i from 2 thru n do
(if a[i] = x then m: m + 1 else (b: endcons([x, m], b), x: a[i], m: 1)),
b: endcons([x, m], b)
)$
look_and_say(s) := apply(sconcat, map(lambda([p], sconcat(string(p[2]), p[1])), collect(charlist(s))))$
block([s: "1"], for i from 1 thru 10 do (disp(s), s: look_and_say(s))); /* "1"
"11" "21" "1211" "111221" "312211" "13112221" "1113213211" "31131211131221" "13211311123113112211" */</lang>
MAXScript
<lang 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
)</lang>
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>
Nimrod
<lang nimrod>proc NextInLookAndSaySequence (current: string): string =
assert(len(current) > 0)
Result = ""
var ch = current[0]
var count = 1
for i in countup(1, len(current)-1):
if current[i] != ch:
Result &= $count & ch
ch = current[i]
count = 1
else:
count += 1
Result &= $count & ch
proc LookAndSay (n = 10) =
var next = "1" for i in countup(1, n): next = NextInLookAndSaySequence(next) echo next
LookAndSay() </lang>
OCaml
Functional
<lang 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</lang>
With regular expressions in the Str library
<lang ocaml>#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</lang>
With regular expressions in the Pcre library
<lang ocaml>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</lang>
run this example with 'ocaml -I +pcre pcre.cma script.ml'
Imperative
<lang ocaml>(* see http://oeis.org/A005150 *)
let look_and_say s = let n = String.length s and buf = Buffer.create 0 and prev = ref s.[0] and count = ref 0 in let append () = Buffer.add_char buf (char_of_int (48 + !count));
Buffer.add_char buf !prev in
String.iter (fun c ->
if c = !prev then incr count else
begin
append ();
prev := c;
count := 1
end
) s; append (); Buffer.contents buf;;
(* what about length of successive strings ? *) let iter f a n = let rec aux r n v = if n = 0
then List.rev(r::v)
else aux (f r) (n - 1) (r::v) in
aux a n [];;
let las = iter look_and_say "1";;
(* the first sixty terms *)
List.map (String.length) (las 59);; (*
[1; 2; 2; 4; 6; 6; 8; 10; 14; 20; 26; 34; 46; 62; 78; 102; 134; 176; 226; 302; 408; 528; 678; 904; 1182; 1540; 2012; 2606; 3410; 4462; 5808; 7586; 9898; 12884; 16774; 21890; 28528; 37158; 48410; 63138; 82350; 107312; 139984; 182376; 237746; 310036; 403966; 526646; 686646; 894810; 1166642; 1520986; 1982710; 2584304; 3369156; 4391702; 5724486; 7462860; 9727930; 12680852]
- )
(* see http://oeis.org/A005341 *)</lang>
Oz
<lang 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}</lang>
PARI/GP
<lang parigp>step(n)={
my(v=eval(Vec(Str(n))),cur=v[1],ct=1,out="");
v=concat(v,99);
for(i=2,#v,
if(v[i]==cur,
ct++
,
out=Str(out,ct,cur);
cur=v[i];
ct=1
)
);
eval(out)
}; n=1;for(i=1,20,print(n);n=step(n))</lang>
Pascal
<lang pascal>program LookAndSayDemo(input, output);
uses
SysUtils;
function LookAndSay (s: string): string;
var
item: char;
index: integer;
count: integer;
begin
LookAndSay := ;
item := s[1];
count := 1;
for index:= 2 to length(s) do
if item = s[index] then
inc(count)
else
begin
LookAndSay := LookAndSay + intTostr(count) + item;
item := s[index];
count := 1;
end;
LookAndSay := LookAndSay + intTostr(count) + item;
end;
var
number: string;
begin
writeln('Press RETURN to continue and ^C to stop.');
number := '1';
while not eof(input) do
begin
write(number);
readln;
number := LookAndSay(number);
end;
end.</lang> Output:
% ./LookAndSay Press RETURN to continue and ^C to stop. 1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211^C
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>
Using string as a cyclic buffer: <lang perl>for (my $_ = "1\n"; s/((.)\2*)//s;) { print $1; $_ .= ($1 ne "\n" and length($1)).$2 }</lang>
Perl 6
In Perl 6 it is natural to avoid explicit loops; rather we use the sequence operator to define a lazy sequence, then just use a slice subscript to pull off the first 10 values: <lang perl>my @look-and-say := (
'1',
*.comb(/(.)$0*/).map({ .chars ~ .substr(0,1) }).join
...
*
);
.say for @look-and-say[^10];</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>
PicoLisp
<lang PicoLisp>(de las (Lst)
(make
(while Lst
(let (N 1 C)
(while (= (setq C (pop 'Lst)) (car Lst))
(inc 'N) )
(link N C) ) ) ) )</lang>
Usage: <lang PicoLisp>: (las (1)) -> (1 1)
- (las @)
-> (2 1)
- (las @)
-> (1 2 1 1)
- (las @)
-> (1 1 1 2 2 1)
- (las @)
-> (3 1 2 2 1 1)
- (las @)
-> (1 3 1 1 2 2 2 1)
- (las @)
-> (1 1 1 3 2 1 3 2 1 1)
- (las @)
-> (3 1 1 3 1 2 1 1 1 3 1 2 2 1)</lang>
PowerBASIC
This uses the RLEncode function from the PowerBASIC Run-length encoding entry.
<lang powerbasic>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</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
Prolog
Works with SWI-Prolog.
<lang Prolog>look_and_say(L) :- maplist(write, L), nl, encode(L, L1), look_and_say(L1).
% This code is almost identical to the code of "run-length-encoding" encode(In, Out) :- packList(In, R1), append(R1,Out).
% use of library clpfd allows packList(?In, ?Out) to works
% in both ways In --> Out and In <-- Out.
- - use_module(library(clpfd)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % ?- packList([a,a,a,b,c,c,c,d,d,e], L). % L = [[3,a],[1,b],[3,c],[2,d],[1,e]] . % ?- packList(R, [[3,a],[1,b],[3,c],[2,d],[1,e]]). % R = [a,a,a,b,c,c,c,d,d,e] . % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% packList([],[]).
packList([X],1,X) :- !.
packList([X|Rest],[XRun|Packed]):-
run(X,Rest, XRun,RRest), packList(RRest,Packed).
run(Var,[],[1,Var],[]).
run(Var,[Var|LRest],[N1, Var],RRest):-
N #> 0, N1 #= N + 1, run(Var,LRest,[N, Var],RRest).
run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
dif(Var,Other).
</lang>
Output :
?- look_and_say([1]). 1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 ..........................
Pure
<lang pure>using system;
// Remove the trailing "L" from the string representation of bigints. __show__ x::bigint = init (str x);
say x = val $ strcat $ map (sprintf "%d%s") $ look $ chars $ str x with
look [] = []; look xs@(x:_) = (#takewhile (==x) xs,x) : look (dropwhile (==x) xs);
end;
iteraten 5 say 1; // [1,11,21,1211,111221]
// This prints the entire sequence, press Ctrl-C to abort. do (puts.str) (iterate say 1);</lang>
PureBasic
<lang 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</lang>
Output
Enter start sequence: 1 How many repetitions: 7 Sequence: 1 11 21 1211 111221 312211 13112221 1113213211
Python
<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
<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
As a generator
<lang python>>>> from itertools import groupby, islice
>>>
>>> def lookandsay(number='1'):
while True:
yield number
number = .join( str(len(list(g))) + k
for k,g in groupby(number) )
>>> print('\n'.join(islice(lookandsay(), 10)))
1
11
21
1211
111221
312211
13112221
1113213211
31131211131221
13211311123113112211</lang>
Using regular expressions
<lang python>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)</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>
Racket
<lang Racket>
- lang racket
(define (encode str)
(regexp-replace* #px"(.)\\1*" str (lambda (m c) (~a (string-length m) c))))
(define (look-and-say-sequence n)
(reverse (for/fold ([r '("1")]) ([n n]) (cons (encode (car r)) r))))
(for-each displayln (look-and-say-sequence 10)) </lang>
Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221
REXX
Programming note: this version works with any string (a null is assumed, which causes 1 to be used).
If a negative number is specified (the number of iterations to be used for the calculations), only the length of
the number (or character string) is shown.
<lang rexx>/*REXX pgm displays the sequence (or lengths) for the look & say series.*/
parse arg N ! .; if N== then N=20 /*No nums given? Then use default*/
if !== then !=1 /*Null? Then assume 1st number.*/
do j=1 for abs(N) /*repeat a # times to show NUMS.*/
if j\==1 then !=$lookAndSay(!) /*invoke sub to calculate next #.*/
if N<0 then say 'length['j"]:" length(!) /*show its length.*/
else say ! /*show the number to the screen. */
end /*j*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────$LOOKANDSAY subroutine──────────────*/ $lookAndSay: procedure; parse arg x,,$ /*define the argument passed {X}.*/ fin = '0'x /*use unique char to end scanning*/ x=x || fin /*append FIN character to string.*/
do k=1 by 0 /*now, process the given sequence*/
y=substr(x,k,1) /*pick off one char to examine. */
if y==fin then return $ /*if we're at the end, then done.*/
_=verify(x,y,,k) - k /*see how many chars we have of Y*/
$=$ || _ || y /*build the "say" thingy list. */
k=k + _ /*now, point to the next char. */
end /*forever*/</lang>
output when using the default value of 20
[1]: 1 [2]: 11 [3]: 21 [4]: 1211 [5]: 111221 [6]: 312211 [7]: 13112221 [8]: 1113213211 [9]: 31131211131221 [10]: 13211311123113112211 [11]: 11131221133112132113212221 [12]: 3113112221232112111312211312113211 [13]: 1321132132111213122112311311222113111221131221 [14]: 11131221131211131231121113112221121321132132211331222113112211 [15]: 311311222113111231131112132112311321322112111312211312111322212311322113212221 [16]: 132113213221133112132113311211131221121321131211132221123113112221131112311332111213211322211312113211 [17]: 11131221131211132221232112111312212321123113112221121113122113111231133221121321132132211331121321231231121113122113322113111221131221 [18]: 31131122211311123113321112131221123113112211121312211213211321322112311311222113311213212322211211131221131211132221232112111312111213111213211231131122212322211331222113112211 [19]: 1321132132211331121321231231121113112221121321132122311211131122211211131221131211132221121321132132212321121113121112133221123113112221131112311332111213122112311311123112111331121113122112132113213211121332212311322113212221 [20]: 11131221131211132221232112111312111213111213211231132132211211131221131211221321123113213221123113112221131112311332211211131221131211132211121312211231131112311211232221121321132132211331121321231231121113112221121321133112132112312321123113112221121113122113121113123112112322111213211322211312113211
output when the following is specified: 17 ggg
[1]: ggg [2]: 3g [3]: 131g [4]: 1113111g [5]: 3113311g [6]: 132123211g [7]: 11131211121312211g [8]: 31131112311211131122211g [9]: 132113311213211231132132211g [10]: 11131221232112111312211213211312111322211g [11]: 3113112211121312211231131122211211131221131112311332211g [12]: 1321132122311211131122211213211321322112311311222113311213212322211g [13]: 1113122113121122132112311321322112111312211312111322211213211321322123211211131211121332211g [14]: 31131122211311122122111312211213211312111322211231131122211311123113322112111312211312111322111213122112311311123112112322211g [15]: 132113213221133122112231131122211211131221131112311332211213211321322113311213212322211231131122211311123113223112111311222112132113311213211221121332211g [16]: 11131221131211132221231122212213211321322112311311222113311213212322211211131221131211132221232112111312111213322112132113213221133112132113221321123113213221121113122123211211131221222112112322211g [17]: 31131122211311123113321112132132112211131221131211132221121321132132212321121113121112133221123113112221131112311332111213122112311311123112112322211211131221131211132221232112111312211322111312211213211312111322211231131122111213122112311311221132211221121332211g
output when the following is specified: -44
length[1]: 1 length[2]: 2 length[3]: 2 length[4]: 4 length[5]: 6 length[6]: 6 length[7]: 8 length[8]: 10 length[9]: 14 length[10]: 20 length[11]: 26 length[12]: 34 length[13]: 46 length[14]: 62 length[15]: 78 length[16]: 102 length[17]: 134 length[18]: 176 length[19]: 226 length[20]: 302 length[21]: 408 length[22]: 528 length[23]: 678 length[24]: 904 length[25]: 1182 length[26]: 1540 length[27]: 2012 length[28]: 2606 length[29]: 3410 length[30]: 4462 length[31]: 5808 length[32]: 7586 length[33]: 9898 length[34]: 12884 length[35]: 16774 length[36]: 21890 length[37]: 28528 length[38]: 37158 length[39]: 48410 length[40]: 63138 length[41]: 82350 length[42]: 107312 length[43]: 139984 length[44]: 182376
Ruby
<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>
- Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211
Using Enumerable#chunk <lang ruby>def lookandsay(str)
str.chars.chunk{|c| c}.map{|c,x| [x.size, c]}.join
end
puts num = "1" 9.times do
puts num = lookandsay(num)
end</lang> The output is the same above.
Without regular expression:
<lang ruby># Adding clusterization (http://apidock.com/rails/Enumerable/group_by) module Enumerable
# clumps adjacent elements together
# >> [2,2,2,3,3,4,2,2,1].cluster
# => [[2, 2, 2], [3, 3], [4], [2, 2], [1]]
def cluster
cluster = []
each do |element|
if cluster.last && cluster.last.last == element
cluster.last << element
else
cluster << [element]
end
end
cluster
end
end</lang>
Using Array#cluster defined above:
<lang ruby>def print_sequence(input_sequence, seq=10)
return unless seq > 0 puts input_sequence.join result_array = input_sequence.cluster.map do |cluster| [cluster.count, cluster.first] end print_sequence(result_array.flatten, seq-1)
end
print_sequence([1])</lang> The output is the same above.
Scala
<lang 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)</lang>
Seed7
<lang seed7>$ include "seed7_05.s7i";
const func string: lookAndSay (in integer: level, in string: stri) is func
result
var string: lookAndSay is "";
local
var integer: index is 2;
begin
if level = 1 then
if stri <> "" then
while index <= length(stri) and stri[index] = stri[1] do
incr(index);
end while;
lookAndSay := str(pred(index)) & stri[1 len 1] & lookAndSay(level, stri[index ..]);
end if;
else
lookAndSay := lookAndSay(1, lookAndSay(pred(level), stri));
end if;
end func;
const proc: main is func
local
var integer: level is 0;
begin
for level range 1 to 14 do
writeln(lookAndSay(level, "1"));
end for;
end func;</lang>
Output:
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221
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>
SNOBOL4
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.
<lang SNOBOL4>* # 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</lang>
Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211
SQL
<lang 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;</lang>
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
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>
Alternatively, with coroutines:
<lang tcl>proc seq_lookandsay {n {coroName next_lookandsay}} {
coroutine $coroName apply {n {
for {} {[yield $n] ne "stop"} {set n $new} {
set new ""
foreach subseq [regexp -all -inline {0+|1+|2+|3+|4+|5+|6+|7+|8+|9+} $n] {
append new [string length $subseq] [string index $subseq 0]
}
}
}} $n
}
puts [seq_lookandsay 1] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay] puts [next_lookandsay]</lang> Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211
TUSCRIPT
<lang tuscript> $$ MODE TUSCRIPT,{} num=1,say=""
LOOP look digits=STRINGS (num," ? ") digitgrouped=ACCUMULATE (digits,howmany) LOOP/CLEAR h=howmany,digit=digitgrouped say=JOIN (say,"",h,digit) ENDLOOP PRINT say num=VALUE(say),say="" IF (look==14) EXIT ENDLOOP
</lang> Output:
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221
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
- import nat
look_and_say "n" = ~&H\'1' next"n" rlc~&E; *= ^lhPrT\~&hNC %nP+ length
- show+
main = look_and_say 10</lang> output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211
VBA
<lang VBA> Public Sub LookAndSay(Optional Niter As Integer = 10) 'generate "Niter" members of the look-and-say sequence '(argument is optional; default is 10)
Dim s As String 'look-and-say number Dim news As String 'next number in sequence Dim curdigit As String 'current digit in s Dim newdigit As String 'next digit in s Dim curlength As Integer 'length of current run Dim p As Integer 'position in s Dim L As Integer 'length of s
On Error GoTo Oops 'to catch overflow, i.e. number too long
'start with "1" s = "1" For i = 1 To Niter
'initialise
L = Len(s)
p = 1
curdigit = Left$(s, 1)
curlength = 1
news = ""
For p = 2 To L
'check next digit in s
newdigit = Mid$(s, p, 1)
If curdigit = newdigit Then 'extend current run
curlength = curlength + 1
Else ' "output" run and start new run
news = news & CStr(curlength) & curdigit
curdigit = newdigit
curlength = 1
End If
Next p
' "output" last run
news = news & CStr(curlength) & curdigit
Debug.Print news
s = news
Next i Exit Sub
Oops:
Debug.Print If Err.Number = 6 Then 'overflow Debug.Print "Oops - number too long!" Else Debug.Print "Error: "; Err.Number, Err.Description End If
End Sub </lang>
Output:
LookAndSay 7 11 21 1211 111221 312211 13112221 1113213211
(Note: overflow occurs at 38th iteration!)
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
VBScript
Implementation
<lang vb>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</lang>
Invocation
<lang vb>dim m m = 1 for i = 0 to 13 m = looksay(m) wscript.echo m next</lang>
Output
11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221
Yorick
<lang yorick>func looksay(input) {
// Special case: one digit
if(strlen(input) == 1)
return "1" + input;
// Convert string into an array of digits
digits = strchar(input)(:-1);
// Find indices where each run starts
w = where(digits(dif));
start = numberof(w) ? grow(1, w+1) : [1];
// Find length of each run
len = grow(start, numberof(digits)+1)(dif);
// Find digits for each run
run = digits(start);
// Construct output array
result = array(string, numberof(start)*2);
// Fill in lengths
result(1::2) = swrite(format="%d", len);
// Fill in digits; first must add trailing nulls to coerce single string
// into an array of strings.
run = transpose([run, array(char(0), numberof(run))])(*);
result(2::2) = strchar(run);
// Merge string array into single string
return result(sum);
}
val = "1"; do {
write, val; val = looksay(val);
} while(strlen(val) < 80);</lang>
Output:
1 11 21 1211 111221 312211 13112221 1113213211 31131211131221 13211311123113112211 11131221133112132113212221 3113112221232112111312211312113211 1321132132111213122112311311222113111221131221 11131221131211131231121113112221121321132132211331222113112211 311311222113111231131112132112311321322112111312211312111322212311322113212221
- Programming Tasks
- Text processing
- Ada
- ALGOL 68
- AutoHotkey
- APL
- AWK
- BBC BASIC
- C
- C++
- C sharp
- Clojure
- Common Lisp
- D
- E
- Erlang
- Factor
- Forth
- Fortran
- GAP
- Go
- Groovy
- Haskell
- Haxe
- Icon
- Unicon
- J
- Java
- JavaScript
- K
- Lasso
- Logo
- Lua
- M4
- Mathematica
- Maxima
- MAXScript
- Metafont
- Nimrod
- OCaml
- Oz
- PARI/GP
- Pascal
- SysUtils
- Perl
- Perl 6
- PHP
- PicoLisp
- PowerBASIC
- PowerShell
- Prolog
- Pure
- PureBasic
- Python
- R
- Racket
- REXX
- Ruby
- Scala
- Seed7
- Smalltalk
- SNOBOL4
- SQL
- SQLite
- Tcl
- TUSCRIPT
- Ursala
- VBA
- Vedit macro language
- VBScript
- Yorick