There's an ant on my Rubik's Cube
Perl, 156 143 134 128 127 125 120 119 117 113 109 bytes
Includes +1 for -p
Run with the control string on STDIN, e.g.
perl -p rubic.pl <<< "^^>^^<^^^"
rubic.pl:
@1=wryobg=~/./g;s##$n=w&$&;$y+=$x-=$y+=$x,@1[0,4,2,5,3,1]=@1while--$n%9;@{$n&&--$y%3}[3,0..2]=@1;$1[$n+9]#eg
Explanation
Older version:
@f=gboyrw=~/./g;s##$n=w&$&;$y+=$x-=$y+=$x,@f=@f[2,4,1,3,0,5]while--$n%9;@f=@f[0,$y=1,5,2..4]if$n&&$y--<0;$f[$n+8]#eg
The challenge of this question is to find a coordinate system that makes it easy to track the position and direction of the ant and to still easily get the face identity.
The system I chose was to put standard (x,y) coordinates on the face the ant is on such that the ant is always facing in the negative y direction with the center of the face being (0,0). So:
rotate right: (x',y') <- (-y, x)
rotate left: (x',y') <- ( y, -x) alternatve: 3 right rotations
Step forward: y' <- y-1
If y was already -1 the ant will leave the current face and step onto the next one. In the new coordinate system there x keeps its value, but y' becomes 1.
This gives an easy coordinate system within a face. I also need something for the faces themselves. There I use an array consisting of
The face to right of the ant g in the initial position
The face to the left of of the ant b
The face behind the ant o
The face opposite to the ant y
The face before the ant r
The face the ant is on w
So the initial array is (g,b,o,y,r,w). Moving to the next face corresponds to rotating the last 4 elements, so moving from white to red makes this (g,b,w,o,y,r). Turning right is a permutation of the first 5 elements giving (o,r,b,y,g,w). Turning left is a simular permutation but can also be done by turning right 3 times, so applying this permutation 3 times. And not turning at all can also be done by applying the permutation 8 times. In fact turning right can also be done by applying the permutation 5 times.
Knowing this the program is rather simple:
@f=gboyrw=~/./g Set up the initial face orientation
s## ... #eg Process each control string character
{this is equivalent to s#.#...#eg because
the empty regex repeats the last
succesful regex)
$n=w&$& Calculate n, the number of right
rotations+1 modulo 9.
This abuses a coincidence of the control
characters:
"<" & "w" = "4" -> 3 right rotations
">" & "w" = "6" -> 5 right rotations
"^" & "w" = "V" = 0 but that is 9 mod 9
so leads to 8 right rtations
$y+=$x-=$y+=$x, This is the same as ($x,$y)=(-$y,$x), so
a right rotation of the face coordinates
@f=@f[2,4,1,3,0,5] Right rotation of the face array
while --$n%9 Rotate right n-1 times. After this n=0
If this was a step then n was effectively 0.
So rotate right 8 times leaving n=-9
... if $n If a step...
$y-- ... decrease y ...
&&$y--<0 ... but if y was already negative ...
@f=@f[0,$y=1,5,2..4] ... change face and set y to 1
$f[$n+8] return the last element (current face)
if this was a step, otherwise empty
So for that last statement rotations lead to the empty string and steps forward lead to the current face. Therefore $_ gets replaced by the faces visited on each step.
Brachylog, 287 bytes
:1:2222:"w":"y":["r":"b":"o":"g"]{h""|[L:I:N:A:B:[C:D:E:F]]hhM("^",(NhI,CwX,EY,B:D:A:FZ;AwX,BY,[C:D:E:F]Z),NhJ,(I1,2313O;I2,(Nh2,N$($(O;Nh1,2222O;Nbh1,3223O;3322O);3322N,2332O;3223N,2233O;2233N,3132O;2332N,3231O);IJ,AX,BY,(M"<",[C:D:E:F]$(Z,N$(O;M">",[C:D:E:F]$)Z,N$)O)),Lb:J:O:X:Y:Z:1&}
Expects a string containing the moves as Input, and no Output, e.g. brachylog_main("^^>^^<^^^",_). will write wrrgggy to STDOUT.
Explanation
§ There are 3 types of tiles we can be on: centers (noted 1), edges (2) and corners (3)
§ When we are on a tile, we can denote adjacent tiles in order: front, left, back, right
§ Similarly, we can denote the adjacent colors depending on the current one of the face
§
§ We start on the center (1) of face white ("w"). The adjacent tiles are 4 edges (2222)
§ The adjacent colors of white are red, blue, orange and green ("r":"b":"o":"g")
§ Yellow is opposite of white ("y")
§ We pass those initial conditions in an array, with the sequence of moves as first
§ element, as input to subpredicate 1
:1:2222:"w":"y":["r":"b":"o":"g"]{...}
§ SUB-PREDICATE 1
h"" § If the sequence of moves is empty, terminate the recursion
| § Else...
§ Here are the variables' names of the input (which correspond to what's described in
§ the first few paragraphs)
[L:I:N:A:B:[C:D:E:F]]
§ If the move is "^"...
hhM("^",
§ The only way we change from one face to another is if the tile we end up on is of the
§ same type as the tile we started from
(NhI, § If this is the case
CwX, § Then write the color of the face we're facing, this face will now be the
§ current color
EY, § The third color in the list is now the opposite color
B:D:A:FZ § The opposite color is now the one we face, the color behind us (the third
§ in the list) is the one we were on, and the other 2 don't change
§ If the tiles are not the same type, then we don't change color
;
AwX, § Write the current color, this will remain the color
BY, § Opposite color stays the same
[C:D:E:F]Z), § Other colors stay in the same order since we moved forward
NhJ, § The new tile type is the one we were facing
(I1,2313O; § If we were on the center, then the adjacent tiles are 2313
I2, § Else if we were on an edge
(Nh2,N$($(O; § then if we were facing an edge (changed face), then the new types
§ of tiles are a double circular permutation of the previous types
Nh1,2222O; § Else if we were facing a center, then the new tiles are 2222
Nbh1,3223O; § Else (corners) if the tile to our left is the center, then 3223
3322O) § Else 3322
; § Else if we were on a corner
3322N,2332O; § then one of those 4 possibilities applies
3223N,2233O;
2233N,3132O;
2332N,3231O)
§ Else if the move is NOT "^"
;
IJ,AX,BY, § We stay on the same type of tile, same color, same opposite color
(M"<", § if the move is "turn left"
[C:D:E:F]$(Z, § Then we circular permute the adjacent colors to the left
N$(O § we also circular permute the adjacent tiles to the left
;M">", § Else if the move is "turn right"
[C:D:E:F]$)Z, § Then we do the same but with right circular permutations
N$)O)
),
Lb:J:O:X:Y:Z:1& § Recursively call sub-predicate 1 with the new input, and the next move
Equivalent SWI-Prolog code
If you don't want to bother with Brachylog's compiler, you can run this solution in SWI-Prolog using the following code (this is what gets generated by Brachylog's compiler):
:- style_check(-singleton).
:- use_module(library(clpfd)).
brachylog_main(Input,Output) :-
1=1,
brachylog_subpred_1([Input,1,2222,"w","y",["r","b","o","g"]],V0).
brachylog_subpred_1(Input,Output) :-
1=1,
brachylog_head(Input, "").
brachylog_subpred_1(Input,Output) :-
1=1,
[L,I,N,A,B,[C,D,E,F]] = Input,
brachylog_head([L,I,N,A,B,[C,D,E,F]], V0),
brachylog_head(V0, M),
( 1=1,
"^" = M,
( 1=1,
brachylog_head(N, I),
brachylog_write(C, X),
Y = E,
Z = [B,D,A,F]
;
1=1,
brachylog_write(A, X),
Y = B,
Z = [C,D,E,F]
),
brachylog_head(N, J),
( 1=1,
I = 1,
O = 2313
;
1=1,
I = 2,
( 1=1,
brachylog_head(N, 2),
brachylog_math_circular_permutation_left(N, V1),
brachylog_math_circular_permutation_left(V1, O)
;
1=1,
brachylog_head(N, 1),
O = 2222
;
1=1,
brachylog_behead(N, V2),
brachylog_head(V2, 1),
O = 3223
;
1=1,
O = 3322
)
;
1=1,
N = 3322,
O = 2332
;
1=1,
N = 3223,
O = 2233
;
1=1,
N = 2233,
O = 3132
;
1=1,
N = 2332,
O = 3231
)
;
1=1,
J = I,
X = A,
Y = B,
( 1=1,
"<" = M,
brachylog_math_circular_permutation_left([C,D,E,F], Z),
brachylog_math_circular_permutation_left(N, O)
;
1=1,
">" = M,
brachylog_math_circular_permutation_right([C,D,E,F], Z),
brachylog_math_circular_permutation_right(N, O)
)
),
brachylog_behead(L, V3),
brachylog_call_predicate([V3,J,O,X,Y,Z,1], V4).
brachylog_behead(X,Y) :-
string(X),!,
sub_string(X, 1, _, 0, Y)
;
number(X),!,
number_codes(X,[_|T]),
catch(number_codes(Y,T),_,Y=[])
;
atom(X),!,
atom_codes(X,[_|T]),
atom_codes(Y,T)
;
X = [_|Y].
brachylog_math_circular_permutation_left(X,Y) :-
string(X),!,
string_codes(X,C),
C = [H|T],
append(T,[H],D),
string_codes(Y,D)
;
number(X),!,
number_codes(X,C),
C = [H|T],
append(T,[H],D),
number_codes(Y,D)
;
atom(X),!,
atom_codes(X,C),
C = [H|T],
append(T,[H],D),
atom_codes(Y,D)
;
X = [H|T],!,
append(T,[H],Y).
brachylog_math_circular_permutation_right(X,Y) :-
string(X),!,
string_codes(X,C),
append(T,[H],C),
D = [H|T],
string_codes(Y,D)
;
number(X),!,
number_codes(X,C),
append(T,[H],C),
D = [H|T],
number_codes(Y,D)
;
atom(X),!,
atom_codes(X,C),
append(T,[H],C),
D = [H|T],
atom_codes(Y,D)
;
append(T,[H],X),
Y = [H|T].
brachylog_call_predicate(X,Y) :-
reverse(X,R),
R = [N|RArgs],
number(N),
reverse(RArgs, Args),
(
N = 0,!,
Name = brachylog_main
;
atom_concat(brachylog_subpred_,N,Name)
),
(
Args = [UniqueArg],!,
call(Name,UniqueArg,Y)
;
call(Name,Args,Y)
).
brachylog_write(X,Y) :-
X = [List,Format],
is_list(List),
string(Format),!,
format(Format,List),
flush_output,
Y = List
;
write(X),
flush_output,
Y = X.
brachylog_head(X,Y) :-
string(X),!,
sub_string(X, 0, 1, _, Y)
;
number(X),!,
number_codes(X,[A|_]),
number_codes(Y,[A])
;
atom(X),!,
atom_codes(X,[A|_]),
atom_codes(Y,[A])
;
X = [Y|_].
PowerShell, 882 bytes
Usage
Save the code in a script and call it like this from the command line. Assuming working directory is the current directory.
.\WalkingAntcg.ps1 "^^>^^<^^^"
Code
$o=[char[]]"grbowy";[int]$c=4;[int]$global:x=1;[int]$global:y=1;[int]$f=1;[int]$n=5;
$u={$c=$args[0];$1="341504251435240503210123".Substring($c*4,4);$2=$1*2-match".$($args[1]).";$3=$Matches[0];"$3";"012345"-replace([char[]]"$1$c"-join"|")}
function t{param($o,$x,$y)if($o){switch($y){0{switch($x){0{$x=2}1{$y=1;$x=2}2{$y=2}}}1{switch($x){0{$y=0;$x=1}2{$y=2;$x=1}}}2{switch($x){0{$x=0;$y=0}1{$x=0;$y=1}2{$x=0}}}}}else{switch($y){0{switch($x){0{$y=2}1{$x=0;$y=1}2{$x=0}}}1{switch($x){0{$y=2;$x=1}2{$y=0;$x=1}}}2{switch($x){0{$x=2}1{$x=2;$y=1}2{$y=0;$x=2}}}}}$global:x=$x;$global:y=$y}
([char[]]$args[0]|%{switch($_){'^'{$global:y++;if($global:y-eq3){$global:y=0;$c="$f";$f="$n";$z=&$u $c $f;$f,$n="$($z[0][1])","$($z[1])"}$o[$c]}
"<"{$z=&$u $c $f;$f,$n="$($z[0][0])","$($z[1])";t 0 $global:x $global:y}
">"{$z=&$u $c $f;$f,$n="$($z[0][2])","$($z[1])";t 1 $global:x $global:y}}})-join""
Less golfed code with explanation
# Recorded order of cube colours and their indexes
# Green=0,Red=1,Blue=2,Orange=3,White=4,Yellow=5
$o=[char[]]"grbowy"
[int]$c=4 # Ant is currently on this colour
[int]$global:x=1 # X coordinate on this face
[int]$global:y=1 # Y coordinate on this face
[int]$f=1 # Colour that the Ant is facing
[int]$n=5 # Colour beyond that the ant is facing.
# If the ant moves of this cube to the next this value becomes the one he is facing.
# It is also the only colour not neighboring this current colour.
# Anonymous function that will return the colour facing left and right
$u = {
# Cube relationships relative to position. Groups of 4 colours that are important given the order...
# Green=0-3,Red=4-7,Blue=8-11,Orange=12-15,White=16-19,Yellow=20-23
# Get the colours surrounding the current colour we are on and the surrounding ones
# String version: "owrygwbyrwoybwgygrbogrbo"
$c=$args[0]
# "341504251435240501230123"
$1="341504251435240503210123".Substring($c*4,4)
# double the string so that we can get the characters before and after the facing colour reliably
# Assign the output to surpress a boolean. $2 is not used. Shorter than a cast
$2=$1*2-match".$($args[1]).";$3=$Matches[0]
# Return two values. First is the colours to the left,current and right as a string.
# Second is the colour beyond the one we are facing. If we were to move forward two blocks
# we would end up on this colour
"$3";"012345"-replace([char[]]"$1$c"-join"|")
}
# function that will transpose the ants position based on right/left rotation.
# Using current x and y determines what the tranposed values are and return them.
function t{
param($o,$x,$y)
# X = $1; Y = $2
# Left 0 Right 1
if($o){
# Right Transpose
# All values are hard coded to rotate to their new positions
switch($y){
0{switch($x){0{$x=2}1{$y=1;$x=2}2{$y=2}}}
# 1,1 is in the center and nothing changes
1{switch($x){0{$y=0;$x=1}2{$y=2;$x=1}}}
2{switch($x){0{$x=0;$y=0}1{$x=0;$y=1}2{$x=0}}}
}
}else{
# Left Transpose
# All values are hard coded to rotate to their new positions
switch($y){
0{switch($x){0{$y=2}1{$x=0;$y=1}2{$x=0}}}
# 1,1 is in the center and nothing changes
1{switch($x){0{$y=2;$x=1}2{$y=0;$x=1}}}
2{switch($x){0{$x=2}1{$x=2;$y=1}2{$y=0;$x=2}}}
}
}
# Update global variables with the ones from this function
$global:x=$x
$global:y=$y
}
# Process each character passed by standard input
([char[]]$args[0]|%{
switch($_){
# Moving Forward
'^'{
$global:y++
if($global:y-eq3){
# We have walked of the colour onto the next one. Update coordinates to the next colour
$global:y=0
$c="$f"
$f="$n"
# Get the new neighboring colour indexes
$z=&$u $c $f
$f,$n="$($z[0][1])","$($z[1])"
}
# Output the colour we have just moved to.
$o[$c]
}
# Turn Left
"<"{$z=&$u $c $f;$f,$n="$($z[0][0])","$($z[1])"
# Transpose the ants location by passing current location to the transposition function.
t 0 $global:x $global:y
}
# Turn Right
">"{$z=&$u $c $f;$f,$n="$($z[0][2])","$($z[1])"
# Transpose the ants location by passing current location to the transposition function.
t 1 $global:x $global:y
}
}
}) -join ""
# Line above converts the output to a single string.
Using a lot of single letter variables used to records the ant current state (colour,position and orientation). The ant is always facing up. When a rotate instruction is read the cube is transposed in that direction. Hardcoded transposition matrices used to determine new position based on current position.
Code satisfies all examples in question.