Railway circuit: Difference between revisions

Line 1,195:

=={{header|Phix}}==

<lang Phix>~~constant right = 1,~~

with javascript_semantics

left = -1,

constant right = 1,

straight = 0

left = -1,

straight = 0

function fullCircleStraight(sequence tracks, integer nStraight)

if nStraight == 0 then return true end if

function fullCircleStraight(sequence tracks, integer nStraight)

if nStraight == 0 then return true end if

-- check symmetry of straight tracks: i and i + 6, i and i + 4

sequence straightTracks =repeat(0,12)

-- check symmetry of straight tracks: i and i + 6, i and i + 4

integer idx = 0

sequence straightTracks = repeat(0,12)

for i=1 to length(tracks) do

integer idx = 0

if tracks[i] == straight then

for i=1 to length(tracks) do

straightTracks[mod(idx,12)+1] += 1

if tracks[i] == straight then

end if

integer stdx = mod(idx,12)+1

idx += tracks[i]

straightTracks[stdx] += 1

if idx<0 then exit end if

end if

end for

idx += tracks[i]

bool any = false

if idx<0 then exit end if

for i=1 to 6 do

end for

if straightTracks[i] != straightTracks[i+6] then

bool any = false

any = true

for i=1 to 6 do

exit

if straightTracks[i] != straightTracks[i+6] then

end if

any = true

end for

exit

if not any then return true end if

end if

any = false

end for

for i=1 to 8 do

if not any then return true end if

if straightTracks[i] != straightTracks[i+4] then

any = false

any = true

for i=1 to 8 do

exit

if straightTracks[i] != straightTracks[i+4] then

end if

any = true

end for

exit

return not any

end if

end function

end for

return not any

function fullCircleRight(sequence tracks)

end function

-- all tracks need to add up to a multiple of 360, aka 12*30

integer tot := 0

function fullCircleRight(sequence tracks)

for i=1 to length(tracks) do

-- all tracks need to add up to a multiple of 360, aka 12*30

tot += tracks[i]

integer tot := 0

end for

for i=1 to length(tracks) do

if mod(tot,12)!=0 then

tot += tracks[i]

return false

end for

end if

if mod(tot,12)!=0 then

return false

-- check symmetry of right turns: i and i + 6, i and i + 4

end if

sequence rTurns = repeat(0,12)

integer idx = 0

-- check symmetry of right turns: i and i + 6, i and i + 4

for i=1 to length(tracks) do

sequence rTurns = repeat(0,12)

if tracks[i] == right then

integer idx = 0

rTurns[mod(idx,12)+1] += 1

for i=1 to length(tracks) do

end if

if tracks[i] == right then

idx += tracks[i]

integer rtdx = mod(idx,12)+1

if idx<0 then exit end if

rTurns[rtdx] += 1

end for

end if

bool any = false

idx += tracks[i]

for i=1 to 6 do

if idx<0 then exit end if

if rTurns[i] != rTurns[i+6] then

end for

any = true

bool any = false

exit

for i=1 to 6 do

end if

if rTurns[i] != rTurns[i+6] then

end for

any = true

if not any then return true end if

exit

any = false

end if

for i=1 to 8 do

end for

if rTurns[i] != rTurns[i+4] then

if not any then return true end if

any = true

any = false

exit

for i=1 to 8 do

end if

if rTurns[i] != rTurns[i+4] then

end for

any = true

return not any

exit

end function

end if

end for

integer carry = 0, lc, sdx, tStraight

return not any

sequence choices, indices, tracks

end function

procedure next(integer nStraight)

integer carry = 0, lc, sdx, tStraight

sequence choices, indices, tracks

/* The generator skips the first index, so the result will always start

with a right turn (0) and we avoid clockwise/counter-clockwise

procedure next(integer nStraight)

duplicate solutions. */

while true do

/* The generator skips the first index, so the result will always start

carry = 1

with a right turn (0) and we avoid clockwise/counter-clockwise

for i=2 to length(indices) do

duplicate solutions. */

integer ii = indices[i]+1

while true do

if ii<=lc then

carry = 1

indices[i] = ii

for i=2 to length(indices) do

tracks[i] = choices[ii]

integer ii = indices[i]+1

tStraight += (ii=sdx)

if ii<=lc then

carry = 0

indices[i] = ii

exit

tracks[i] = choices[ii]

end if

tStraight += (ii=sdx)

indices[i] = 1

carry = 0

tracks[i] = choices[1]

if ~~sdx~~ ~~then~~

exit

end if

tStraight -= 1

indices[i] = 1

end if

tracks[i] = choices[1]

end for

if sdx then

if carry or (tStraight=nStraight) then exit end if

tStraight -= 1

end while

end if

end procedure

end for

if carry or (tStraight=nStraight) then exit end if

procedure circuits(integer nCurved, nStraight)

end while

atom t0 = time()

end procedure

integer seen = new_dict()

sequence solutions = {}

procedure circuits(integer nCurved, nStraight)

integer nCS = nCurved+nStraight

sequence solutions = {}

if mod(nCS-12,4)!=0 then

integer seen = new_dict(),

crash("input must be 12 + k * 4")

nCS = nCurved+nStraight

end if

if mod(nCS-12,4)!=0 then

switch nStraight do

crash("input must be 12 + k * 4")

case 0: choices = {right, left}

end if

case 12: choices = {right, straight}

switch nStraight do

default: choices = {right, left, straight}

case 0: choices = {right, left}

end switch

case 12: choices = {right, straight}

lc = length(choices)

default: choices = {right, left, straight}

sdx = find(straight,choices)

end switch

tStraight = 0

lc = length(choices)

indices := repeat(1, nCS)

sdx = find(straight,choices)

tracks := repeat(right, nCS)

tStraight = 0

carry := 0

indices := repeat(1, nCS)

while carry=0 do

tracks := repeat(right, nCS)

next(nStraight)

carry := 0

if fullCircleStraight(tracks, nStraight)

while carry=0 do

and fullCircleRight(tracks) then

next(nStraight)

if getd_index(tracks,seen)=0 then

if fullCircleStraight(tracks, nStraight)

solutions = append(solutions,tracks)

and fullCircleRight(tracks) then

-- mark all rotations seen

if getd_index(tracks,seen)=0 then

for i=1 to nCS do

solutions = append(solutions,tracks)

setd(tracks,true,seen) -- (data (=true) is ignored)

-- mark all rotations seen

tracks = tracks[2..$]&tracks[1]

for i=1 to nCS do

end for

setd(tracks,true,seen) -- (data (=true) is ignored)

end if

tracks = tracks[2..$]&tracks[1]

end if

end for

end while

end if

destroy_dict(seen)

end if

integer ls := length(solutions)

end while

string s = iff(ls=1?"":"s")

destroy_dict(seen)

printf(1,"\n%d solution%s for C%d,%d \n", {ls, s, nCurved, nStraight})

integer ls := length(solutions)

if nCurved <= 20 then

string s = iff(ls=1?"":"s")

pp(solutions,{pp_Nest,1})

printf(1,"\n%d solution%s for C%d,%d \n", {ls, s, nCurved, nStraight})

end if

if nCurved <= 20 then

end procedure

pp(solutions,{pp_Nest,1})

end if

for n=12 to 28 by 4 do

end procedure

circuits(n,0)

end for

for n=12 to iff(platform()=JS?20:28) by 4 do

circuits(12,4)</lang>

circuits(n,0)

end for

circuits(12,4)

<pre>