12
$\begingroup$

I am simplifying the question i need too work with, any advice on how to proceed for each step would be appreciated(no answers)

  1. I have a square grid of size a by b, inside the cell is an object that moves diagonally.

  2. We start at any given cell, and the object moves diagonally(in any indicated direction)

  3. When its in a cell on the margin it bounces back(rebounds) on the same angle. (so when it reaches any margin it rebounds

  4. The object stops moving when the path its on starts to repeat or it can't move in the indicated direction anymore

  5. The path of this object has to be displayed. Also the number of cells it visited

Im trying to write a function that takes, parameters a by b(grid size), initial point of obj and direction of where to start moving. This function must return the path the object took

$\endgroup$
0
20
$\begingroup$
ClearAll[step, bishopsPath]

step[{nc_, nr_}][{start : {_, _}, {_, _}}] := {Total @ #, Last[{Total @ #, #[[2]]} /. 
    {{t : start | {1 | nc, 1 | nr}, _} :> {t, {0, 0}},
    {t : {_, nr} | {_, 1}, d_} :> {t, {1, -1} d}, 
    {t : {1, _} | {nc, _}, d_} :> {t, {-1, 1} d}}]} &;

bishopsPath[{nc_, nr_}][arg : Alternatives[{{1, _}, {-1, _}}, 
   {{_, 1}, {_, -1}}, {{nc_, _}, {1, _}}, {{_, nr_}, {_, 1}}]] := {arg[[1]]}

bishopsPath[{nc_, nr_}][{start : {c_, r_}, dir : {1 | -1, 1 | -1}}] /;
   And[1 <= c <= nc, 1 <= r <= nr] := 
    NestWhileList[step[{nc, nr}][{start, dir}], 
      {start, dir}, Last @ # != {0, 0} &][[All, 1]]

Examples:

bishopsPath[{8, 8}][{{3, 1}, {1, 1}}]
 {{3, 1}, {4, 2}, {5, 3}, {6, 4}, {7, 5}, {8, 6}, {7, 7}, {6, 8}, {5,  7}, 
  {4, 6}, {3, 5}, {2, 4}, {1, 3}, {2, 2}, {3, 1}}
Grid[Join[{{Row[{"board size: {5,5}", "start: {3, 2}"}, " ,"], 
      SpanFromLeft}, {"direction", "path"}}, 
    {#, bishopsPath[{5, 5}][{{3, 2}, #}]} & /@ Tuples[{1, -1}, 2]],
 Dividers -> All,
  Alignment -> {Center, Center, {{1, 1} -> Left, {2, 2} -> Left}}]

enter image description here

Grid[Join[{{Row[{"board size: {8,8}", "start: {4, 5}"}, " ,"], 
      SpanFromLeft}, {"direction", "path"}}, 
    {#, bishopsPath[{8, 8}][{{4, 5}, #}]} & /@ Tuples[{1, -1}, 2]],
 Dividers -> All,
  Alignment -> {Center, Center, {{1, 1} -> Left, {2, 2} -> Left}}]

enter image description here

Visualization

To be used as background:

ClearAll[chessBoard, bishopGraph]
chessBoard = ArrayPlot[Array[Mod[# + #2, 2] &, {#2, #}], 
    ColorRules -> {0 -> White, 1 -> GrayLevel[.7]}, ##3] &;

bishopGraph = RelationGraph[Abs[Subtract@##] == {1, 1} &, 
    Tuples[Range /@ {# , #2}], DirectedEdges -> False, 
    VertexCoordinates -> Tuples[Range /@ {#, #2}] - 1/2,  ##3, 
    EdgeStyle -> Directive[Thick, Blue], VertexStyle -> LightBlue, 
    VertexSize -> Medium] &;

Examples:

With[{nc = 10, nr = 7, c = 8, r = 4, dir = {-1, -1}}, 
 Show[chessBoard[nc, nr, DataReversed -> True, FrameTicks -> All], 
  Graphics[{Red, AbsolutePointSize[15], Point[-.5 + {c, r}], 
    Opacity[1], Red, AbsoluteThickness[5], Arrowheads[.04], 
    Arrow /@ Partition[-1/2 + bishopsPath[{nc, nr}][{{c, r}, dir}], 2, 1]}], 
  bishopGraph[nc, nr, VertexSize -> {{c, r} -> .3}, 
   VertexStyle -> {{c, r} -> Yellow}]]]

enter image description here

SeedRandom[7]
Grid@Partition[RotateRight @ With[{nc = 8, nr = 8, 
     start = RandomChoice[Tuples[{Range[8], Range[8]}]]}, 
    Table[path = bishopsPath[{nc, nr}][{start, dir}];
     Labeled[Show[chessBoard[nc, nr, DataReversed -> True, 
        FrameTicks -> All], 
       Graphics[{Red, AbsolutePointSize[12], Point[-.5 + First@path], 
         AbsoluteThickness[3], Red, Arrowheads[.04], 
         Arrow /@ Partition[-.5 + path, 2, 1]}], 
       bishopGraph[nc, nr, EdgeStyle -> Thin, 
        VertexSize -> {start -> .3} , 
        VertexStyle -> {start -> Yellow}], 
       ImageSize -> 360], 
  {PromptForm["start", start], PromptForm["dir", dir], 
   PromptForm["Length", Length[path] - 1]}, Top], {dir, Tuples[{1, -1}, 2]}]], 2]

enter image description here

SeedRandom[7777]
Multicolumn[Table[With[{nc = 7, nr = 7, 
    start = RandomChoice[Tuples[{Range[7], Range[7]}]], 
    dir = RandomChoice[Tuples[{1, -1}, 2]]}, 
   path = bishopsPath[{nc, nr}][{start, dir}];
   Labeled[Show[chessBoard[nc, nr, DataReversed -> True, FrameTicks -> All], 
     Graphics[{Red, AbsolutePointSize[12], Point[-.5 + First@path], 
       AbsoluteThickness[3], Red, Arrowheads[.04], 
       Arrow /@ Partition[-.5 + path, 2, 1]}], 
     bishopGraph[nc, nr, EdgeStyle -> Thin, 
      VertexSize -> {start -> .3} , 
      VertexStyle -> {start -> Yellow}], 
     ImageSize -> 360], 
  {PromptForm["start", start], PromptForm["dir", dir], 
   PromptForm["Length", Length[path] - 1]}, Top]], 6], 3]

enter image description here

SeedRandom[12345]
Multicolumn[Table[With[{nc = 15, nr = 3, 
    start = RandomChoice[Tuples[{Range[15], Range[3]}]], 
    dir = RandomChoice[Tuples[{1, -1}, 2]]}, 
   path = bishopsPath[{nc, nr}][{start, dir}];
   Labeled[Show[chessBoard[nc, nr, DataReversed -> True, FrameTicks -> All], 
     Graphics[{Red, AbsolutePointSize[12], Point[-.5 + First@path], 
       AbsoluteThickness[3], Red, Arrowheads[.04], 
       Arrow /@ Partition[-.5 + path, 2, 1]}], 
     bishopGraph[nc, nr, EdgeStyle -> Thin, 
      VertexSize -> {start -> .3} , 
      VertexStyle -> {start -> Yellow}], 
     ImageSize -> 360], 
    {PromptForm["start", start], PromptForm["dir", dir],
     PromptForm["Length", Length[path] - 1]}, Top]], 6], 3]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.