Perl function 101 char

sub f{($_,$S,$p)=@_;for(%h=map{$i++,$_}split//;7^$S;$p-=$S<=>3){$S=7&236053>>3*($S%4*2+!!$h{$p}++)}};

f(@ARGV);
@allpos = sort keys %h;
for (@allpos){
    print $h{$_}?1:0;
}
print " H ".($p-$allpos[0])."
";

This one was fun to find. Two tricks. It use a hash for the tape, and know what ? A hash is auto-extensible, so no need any more to care about tape boundaries. The other trick is for combining both read and write of the cell accessed. Just had to change internal conventions 0 and space means 0 and any other value means 1. These two tricks implies some trivial decoding of output, but I believe it s ok. I also not counted the final semi-colon in my function as gnibbler didn t counted his in his golfscript.

If someone is interested I can also post my other tries. They are a bit longer but uses fun tricks. One is regex based for instance and works directly with tape as string another one is a kind of bit-fu.

Perl function 112 char

sub f{($_,$S,$p)=@_;for(split//;7^$S;@_=($p=0,@_)if($p-=$S<=>3)<0){$S=7&236053>>3*($S%4*2+$_[$p]);$_[$p]=1}@_};

@res = f@ARGV;
print @res," H $p
";

I counted the function only and it takes a string, a state num and a position in that order as specified. The function returns new tape state as an array.

Another variant 106 char

sub f{($_,$S,$p)=@_;for(split//;7^$S;$p-=$S<=>3){$S=7&236053>>($S%4*6+$_[$p]*3);$_[$p++]=1;@_=(0,@_)}@_};`

@res = f(@ARGV);
print @res," H $p
";

It is not clear if this one is cheating or not. It gives correct results and automatically extends tape (no fixed limit), but to avoid testing if it is necessary or not to extend tape it does so every step and adjust index.

Another variant 98 char

This one is also on the merge but in a different way. It just use globals to pass parameters inside the function. Hence you set your variables outside the function instead of inside. Thus removing 14 characters from the function body.

sub f{for(split//;7^$S;@_=($p=0,@_)if($p-=$S<=>3)<0){$S=7&236053>>3*($S%4*2+$_[$p]);$_[$p]=1}@_};

($_,$S,$p) = @ARGV;
@res = f();
print @res," H $p
";

Python - 133 Characters

Have to beat perl for a while at least :)

def f(t,i,s):
 t=map(int,t) 
 while s<3:t=[0]*-i+t+[0][:i>=len(t)];i*=i>0;c,t[i]=s*4+t[i]*2,1;i+=1-(2&2178>>c);s=3&3401>>c
 return t,i

Python - 172 Characters

def f(t,i,s):
 t=map(int,t)
 while s<3:
  t=[0]*-i+t+[0]*(i-len(t)+1);i=max(0,i);c,t[i]=t[i],1;i,s=[[(i-1,1),(i+1,2)],[(i+1,0),(i-1,s)],[(i+1,1),(i-1,3)]][s][c]
 return t,i

testcases

assert f("1010",3,0) == ([1, 1, 1, 1], 2)
assert f("110100",3,1) == ([1, 1, 1, 1, 1, 1, 1, 1], 1)

C - 282 44 98 chars (including all inner-loop var and table declarations)

#include<stdio.h>
#include<string.h>

char*S="  A2C1C2  C3A2A0";
f(char*p,char c){char*e;while(c){e=S+*p*8+c*2;*p=1;p+=*e++-66;c=*e-48;}}

char T[1000];
main()
{
  char *p;
        char c;
        char *e;

    int initial;
    scanf("%s %d %c",&T[500],&initial,&c);
    c = c -  0  + 1;

    for(p=&T[500]; *p; p++)
        *p -=  0 ;

    p = &T[500+initial];

    f(p, c);

    char *left = T;
    while((left < T+500)&&(!*left))
        left++;

    char *right = T+sizeof(T)-1;
    while((right > T+500)&&(!*right))
        right--;

    initial = p - left;

    for(p=left; p<=right; p++)
        *p+= 0 ;

    printf("%.*s %d

",right-left+1,left,initial);
}

C# - 157 characters

void T(List<int>t,ref int p,int s){while(s!=3){if(p<0)t.Insert(0,p=0);if(p==t.Count)t.Add(0);var c=t[p]==1;t[p]=1;p+=s==0==c?1:-1;s=s==1==c?1:c?s==0?2:3:0;}}

The method takes a List<int> as tape, so it can be expanded as long as memory allows it.

Assertion:

List<int> tape;
int pos;

tape = "1010".Select(c => c -  0 ).ToList();
pos = 3;
T(tape, ref pos, 0);
Debug.Assert(String.Concat(tape.Select(n => n.ToString()).ToArray()) == "1111" && pos == 2);

tape = "110100".Select(c => c -  0 ).ToList();
pos = 3;
T(tape, ref pos, 1);
Debug.Assert(String.Concat(tape.Select(n => n.ToString()).ToArray()) == "11111111" && pos == 1);

If we cheat and allocate a large enough array from start, 107 characters:

void X(int[]t,ref int p,int s){while(s!=3){var c=t[p]==1;t[p]=1;p+=s==0==c?1:-1;s=s==1==c?1:c?s==0?2:3:0;}}

Perl 142 char (not counting reading args on command line and final print. Well, most of code is the beaver program, the engine itself is only 46 char.

I changed input format to put the state at it s position in the string. I don t feel guilty at all as otherwise most of code was going to be border management when head was out of string. Even in this version string border management cost 17 chars... The trick is just to remember you can express turing machines as Markov chains... what I did with regexes.

perl -e  $b=shift;%p=qw(A0|A$ 1B ^A1|0A1 C01 1A1 C11 0B0|^B0 A01 1B0|1B$ A11 B1 1B 0C0|^C0 B01 1C0|1C$ B11 C1 1H);while($b!~/H/){$b=~s/$_/$p{$_}/for keys%p}print"$b
"  00A1011

111H1111

Note: as a matter of fact this is not really golfed yet but just a naive first attempt. I may come back with something real short.

Golfscript - 102 Characters

{:s;{:$;:^0<{0.:^$+:$}{^$}if.,@>! 0 *+.^=1&s.++:c;.^<1+^)>+:$[^(^).^(^)^(]c=:^3"120113"c=3&:s-}do}:f

;
["1010" 3 0 f]p
["110100" 3 1 f]p
["1000000" 3 1 f]p

106 Characters

{:s;:$;:i{0<{0.:i$+:$}{i$}if.,@>! 0 *+.i=1&s.++:c;.i<1+i)>+:$;[i(i).i(i)i(]c=:i 3"120113"c=3&:s-}do$}:f

113 Characters
Whole program reading from stdin

   /(:$;(~:i;~~:s;{0i>{0.:i$+:$}{i$}if.,@>! 0 *+.i=1&s.++:c;.i<1+i)>+:$;[i(i).i(i)i(]c=:i;3"120113"c=3&:s-}do$`i

examples

$ echo -n 1010 3 0 |../golfscript.rb turing.gs 
"1111"2
$ echo -n 110100 3 1 |../golfscript.rb turing.gs 
"11111111"1

To clarify, this program simulates the Busy Beaver Turing Machine exactly as described in the wikipedia article, not the OP (the OP has R and L switched)

Python 255 char

def f(k,i,s):
 t=map(int,k)
 while s<3:
    if i==len(t):t+=[0]
    if i<0:t=[0]+t;i=0
    x=t[i],s
    if x==(0,0):t[i]=1;i-=1;s=1
    if x==(0,1):t[i]=1;i+=1;s=0
    if x==(0,2):t[i]=1;i+=1;s=1
    if x==(1,0):i+=1;s=2
    if x==(1,1):i-=1;s=1
    if x==(1,2):i-=1;s=3
 return t,i

Perl, 97 (96 indeed, because final ";" is optional for sub block)

sub f{($_,$a,pos)=@_;s/G./$&+2*$a+2/e;1while s!(.?)(2|5)|(3|4|6)(.?)!$2?4+$1.1:8+$4+$3+5*/3/!e}
f@ARGV;
#output
s/7/1/;print;print " H ",(-1+length$`);

The idea : $_ variable contains 0s and 1s except under the head. Under the head, 0 in A state gives 2, 1 in A state gives 3, 0 in B state gives 4, 1 in B state gives 5, 0 in C state gives 6, 1 in C state gives 7.

so following the first example "1010" (pos 3, state A) gives "1051" then "1411", "1131", "1117" (1111, state C, pos 3) and stop (plus move tape to right)

Lua:

Semi-golfed version:

a=arg
t=a[1]
i=a[2]+1
s=a[3]+0
r=string.rep
b=string.sub;z="0";o="1";while true do if i<1 then
        t=z..t
        i=1
    elseif i>#t then
        t=t..z
    end
    c=b(t,i,i)
    if i>0 then
        t=b(t,0,i-1)..o..b(t,i+1,#t)
    else
        t="1"..b(t,i+1,#t)
    end
    if s==0 then
        if c==z then
            i=i-1
            s=1
        elseif c==o then
            i=i+1
            s=2
        end
    elseif s==1 then
        if c==z then
            i=i+1
            s=0
        elseif c==o then
            i=i-1
        end
    elseif s==2 then
        if c==z then
            i=i+1
            s=1
        elseif c==o then
            i=i-1
            break
        end
    end
end
print(t,i-1)

Compacted version weighing in at 441 characters:

a=arg t=a[1] i=a[2]+1 s=a[3]+0 r=string.rep b=string.sub;z="0";o="1";while true do if i<1 then t=z..t i=1 elseif i>#t then t=t..z end c=b(t,i,i) if i>0 then t=b(t,0,i-1)..o..b(t,i+1,#t) else t="1"..b(t,i+1,#t) end if s==0 then if c==z then i=i-1 s=1 elseif c==o then i=i+1 s=2 end elseif s==1 then if c==z then i=i+1 s=0 elseif c==o then i=i-1 end elseif s==2 then if c==z then i=i+1 s=1 elseif c==o then i=i-1 break end end end print(t,i-1)

Pass the arguments in form of tape, instruction pointer, state, like the following:

turing.lua 1010 3 0

Lua, 232

Now using table lookup.

j={{-1,1},{1,-1},{1,-1}}u={{1,2},{-1,0},{-1,1}}t,i,s=...i=i+1
s=s+1 z="0"o="1"while s<4 do if i<1 then t=z..t i=1
elseif i>#t then t=t..z end c=t:sub(i,i):byte()-47
t=t:sub(0,i-1)..o..t:sub(i+1)i=i+j[s][c]s=s+u[s][c]end print(t,i-1)

This is just RCIX s answer re-golfed, 332 characters.

t,i,s=...i=i+1 s=s+0 r=string.rep b=string.sub z="0"o="1"while s<3 do if i<1 then
t=z..t i=1 elseif i>#t then t=t..z end c=b(t,i,i)t=b(t,0,i-1)..o..b(t,i+1,#t)if
s<1 then i=i+(c==o and 1 or -1)s=c==z and 1 or 2 elseif s<2 then i=i+(c==o and
-1 or 1)s=c==z and 0 or s else i=i+(c==o and -1 or 1)s=c==z and 1 or 3 end end
print(t,i-1)

• uses ... operator to assign input params
• uses and and or instead of if statements when shorter
• replaced some elseif with just else by assuming valid input/states
• removed spaces after parens, ellipse operator, and end quotes

F# - 275 characters

Okay, so definitely not the shortest but learning. If anyone can assist on getting the String.mapi to use a function rather then the fun match with I would appreciate it, I keep getting The pattern discriminator x is not defined . Anyone know of a site that details the rules of using the function keyword in a lambda?

let rec t s i p=
    match s with
    |3->(p,i)
    |_->let g=[[(1,1);(-1,2)];[(-1,0);(1,1)];[(-1,1);(1,3)]]
        let p=match i with|_ when i<0 ->"0"+p|_ when i=p.Length->p+"0"|_->p
        let i=max 0 i
        let m,n=g.Item(s).Item((int p.[i])-48)
        String.mapi(fun x c->match x with|_ when x=i-> 1 |_->c) p |> t n (i+m)

Usage

t 1 2 "101011" |> printfn "%A"

Here is an expanded version for readability:

let rec tur state index tape =
    printfn "Index %d: State %d: Tape %s:" index state tape
    match state with
    |3 -> (tape, index)
    |_ -> let prog = [[(1,1);(-1,2)];[(-1,0);(1,1)];[(-1,1);(1,3)]]
          let tape = match index with |_ when index<0 ->"0"+tape |_ when index=tape.Length->tape+"0" |_->tape
          let index = max 0 index
          let move,newstate = prog.Item(state).Item((int tape.[index])-48)
          String.mapi (fun i c -> match i with |_ when i=index-> 1  |_->c) tape
          |> tur newstate (index+move)

I m also trying to think of a better way to handle the manipulation of the string, something other then the String.mapi. Comments and suggestions (constructive please) welcome and encouraged.

Ruby, 129

(when indent removed)

def pr t,z,s      # DEBUG
  p [t,s]     # DEBUG
  p [   *z +  ^ ] # DEBUG
end       # DEBUG


def q t,z,s
  s*=2
  (t=t.ljust z+1
    (t=   +t;z=0)if z<0
    a=t[z]&1
    t[z]=?1
    b=s>0?1-a: a
    s="240226"[s|a]&7
    z+=b*2-1)while s!=6
  [t,z]
end

p q "1010",3,0
p q "110100",3,1