(* * Navigation.m * * by K. Pittenger, D. Schlingmann, and D. Whitecotton * * This package contains the function * navigate[stationlist, obstaclelist] which * sets up the graphical and audio simulation of an * object (a blue dot) moving from its starting point * (the first element of stationlist) over * intermediate destinations (the intermediate elements * of stationlist) to its final destination (the last * element of stationlist). The moving object avoids * obstacles (cuboids) listed in obstaclelist. *) (* * Prepend the context Navigation` to $ContextPath. *) BeginPackage["Navigation`"] EndPackage[] navigate::usage = "navigate[stationlist, obstaclelist] \ sets up the graphical and audio simulation of an \ object (a blue dot) moving from its starting point \ (the first element of stationlist) over \ intermediate destinations (the intermediate \ elements of stationlist) to its final destination \ (the last element of stationlist). \ The moving object avoids obstacles (cuboids) \ listed in obstaclelist. \ The graphs also display the time, the total time, \ and the position of the moving object. \ The sound consists of two tones. The closer \ the tones are to each other, the closer the \ moving object is to its final destination. \ The program assumes that no two obstacles \ intersect and that there is enough \ space between any two obstacles for the moving \ object to move through. \ stationlist lists a finite number of points. \ The first point on the list represents the \ starting point. The second point represents \ the first destination of the travelling object, \ and the last point on the list represents the \ final destination. \ obstaclelist lists a finite number of lists. \ Each such list contains two points which \ represent a cuboid. \ The two points portray {xmin, ymin, zmin} and \ {xmax, ymax, zmax} of the cuboid."; (* * Global objects. *) navigate; Begin["Navigation`Private`"]; (* navigate[stationlist, obstaclelist] sets up the graphical and audio simulation of an object (a blue dot) moving from its starting point (the first element of stationlist) over intermediate destinations (the intermediate elements of stationlist) to its final destination (the last element of stationlist). The moving object avoids the obstacles listed in obstaclelist. The graphs also display the time, the total time, and the position of the moving object. The sound consists of two tones. The closer the tones are to each other, the closer the moving object is to its final destination. The program assumes that no two obstacles intersect and that there is enough space between any two obstacles for the moving object to move through. stationlist lists a finite number of points. The first point on the list represents the starting point. The second point represents the first destination of the travelling object, and the last point on the list represents the final destination. obstaclelist lists a finite number of lists. Each such list contains two points which represent a cuboid. The two points portray {xmin, ymin, zmin} and {xmax, ymax, zmax} of the cuboid. faultycub checks if the inputs for the obstacles are correct. c represents the size of the corpus of the moving object. boxinbox checks if two obstacles intersect each other. statinbox checks if a station is in an obstacle. newstationlist makes sure that a station in stationlist is not listed twice in sequence. norm computes the length of the vector v. straightline[t, v, w] represents the equation of the straight line through v and w at time t. The absolute value of t also measures the distance from v. step represents the length of a single step of the moving object. detourlist adds at the right places further intermediate destinations to stationlist which are necessary to make the object go around the given obstacles. This new created list is called detour. myposition[t, stationlist] computes the position of an object at time t. The object travels at a constant speed of one distance-unit per one time-unit, e.g., 1 foot/sec. stationsgr and stationsgraph set up the three dimensional graphical objects of the destination points. cornersgr and cornersgraph supply the same frame for each picture. dim computes an appropriate dimension of the frame depending on the elements of detour and obstaclelist. totaltime represents the total time it takes to move the object from the starting point to the final destination. *) navigate[stationlist_, obstaclelist_] := Module[ {`faultycub, `c, `boxinbox, `statinbox, `newstationlist, `norm, `straightline, `step, `detourlist, `detour, `myposition, `stationsgr, `stationsgraph, `obstaclesgr, `obstaclesgraph, `cornersgr, `cornersgraph, `dim, `totaltime}, faultycub[cub_] := N[(cub[[1,1]] >= cub[[2,1]]) || (cub[[1,2]] >= cub[[2,2]]) || (cub[[1,3]] >= cub[[2,3]])]; c = 1/4; boxinbox[b1_, b2_] := N[((((b1[[1,1]]-c) >= (b2[[1,1]]-c)) && ((b1[[1,1]]-c) <= (b2[[2,1]]+c))) || (((b1[[2,1]]+c) >= (b2[[1,1]]-c)) && ((b1[[2,1]]+c) <= (b2[[2,1]]+c))) || (((b1[[1,1]]-c) <= (b2[[1,1]]-c)) && ((b1[[2,1]]+c) >= (b2[[2,1]]+c)))) && ((((b1[[1,2]]-c) >= (b2[[1,2]]-c)) && ((b1[[1,2]]-c) <= (b2[[2,2]]+c))) || (((b1[[2,2]]+c) >= (b2[[1,2]]-c)) && ((b1[[2,2]]+c) <= (b2[[2,2]]+c))) || (((b1[[1,2]]-c) <= (b2[[1,2]]-c)) && ((b1[[2,2]]+c) >= (b2[[2,2]]+c)))) && ((((b1[[1,3]]-c) >= (b2[[1,3]]-c)) && ((b1[[1,3]]-c) <= (b2[[2,3]]+c))) || (((b1[[2,3]]+c) >= (b2[[1,3]]-c)) && ((b1[[2,3]]+c) <= (b2[[2,3]]+c))) || (((b1[[1,3]]-c) <= (b2[[1,3]]-c)) && ((b1[[2,3]]+c) >= (b2[[2,3]]+c))))]; statinbox[v_,b_] := N[((b[[1,1]]-c) <= v[[1]]) && (v[[1]] <= (b[[2,1]]+c)) && ((b[[1,2]]-c) <= v[[2]]) && (v[[2]] <= (b[[2,2]]+c)) && ((b[[1,3]]-c) <= v[[3]]) && (v[[3]] <= (b[[2,3]]+c))]; If[ (Length[obstaclelist] >= 1) && (Intersection[ {True}, Union[ Flatten[ Table[ faultycub[obstaclelist[[i]]], {i, Length[obstaclelist]}]]]] == {True}), Print["Error: Some obstacles have wrong arguments."], If[ (Length[obstaclelist] >= 2) && (Intersection[ {True}, Union[ Flatten[ Table[ Table[boxinbox[obstaclelist[[i]], obstaclelist[[j]]], {j, i+1, Length[obstaclelist]}], {i, Length[obstaclelist]-1}]]]] == {True}), Print["Error: The obstacles are not separate."], If[ (Length[obstaclelist] >= 1) && (Intersection[ {True}, Union[ Flatten[ Table[ Table[statinbox[stationlist[[i]], obstaclelist[[j]]], {j, Length[obstaclelist]}], {i, Length[stationlist]}]]]] == {True}), Print["Error: A station is in an obstacle."], newstationlist = {stationlist[[1]]}; Do[ If[N[Last[newstationlist] != stationlist[[i+1]]], newstationlist = Append[newstationlist,stationlist[[i+1]]]], {i,1,Length[stationlist]-1}]; norm[u_] := Sqrt[u[[1]]^2+u[[2]]^2+u[[3]]^2]; straightline[s_,x_,y_] := x+s*(y-x)/norm[y-x]; step = 1/5; detourlist[mystationlist_?((Length[#] == 2)&), myobstaclelist_] := Module[ {`statlist, `obslist, (* `norm, `straightline, `c, *) `v, `w, `detour, `positiveobstaclelist, `poblist, `posoblist, `negoblist, `detourcornerpts, `detourcopts, `pob, `myline, `alterpoblist, `upgrade}, statlist = mystationlist; obslist = myobstaclelist; (* norm[u_] := Sqrt[u[[1]]^2+u[[2]]^2+u[[3]]^2]; straightline[s_,x_,y_] := x+s*(y-x)/norm[y-x]; c = 1/4; *) v = statlist[[1]]; w = statlist[[2]]; detour ={v}; positiveobstaclelist[ localstationlist_?((Length[#] == 2)&), localobstaclelist_] := Module[ {`statlist, `obslist, (* `norm, `straightline *) `myline, `solutions, `sol, `f, `mylist, `poblist, `i}, statlist = localstationlist; obslist = localobstaclelist; (* norm[v_] := Sqrt[v[[1]]^2+v[[2]]^2+v[[3]]^2]; straightline[s_,x_,y_] := x+s*(y-x)/norm[y-x]; *) myline[t_] := straightline[t, statlist[[1]], statlist[[2]]]; solutions = {}; If[obslist != {}, Do[ Do[ Do[ sol = Solve[myline[t][[j]] == obslist[[i,k,j]],t]; f[1,1] = 2; f[1,2] = 3; f[2,1] = 1; f[2,2] = 3; f[3,1] = 1; f[3,2] = 2; If[ (sol != {}) && (sol != {{}}) && (sol[[1,1,2]] != ComplexInfinity) && N[(sol[[1,1,2]] >= 0) && (sol[[1,1,2]] <= norm[statlist[[2]]-statlist[[1]]]) && (myline[sol[[1,1,2]]][[f[j,1]]] >= obslist[[i,1,f[j,1]]] && myline[sol[[1,1,2]]][[f[j,1]]] <= obslist[[i,2,f[j,1]]]) && (myline[sol[[1,1,2]]][[f[j,2]]] >= obslist[[i,1,f[j,2]]] && myline[sol[[1,1,2]]][[f[j,2]]] <= obslist[[i,2,f[j,2]]])], AppendTo[solutions, {{sol[[1,1,2]]}, obslist[[i]], {myline[sol[[1,1,2]]]}}] ], {j, 3} ], {k,2} ], {i, Length[obslist]} ]; mylist = Sort[Union[solutions], (N[#1[[1,1]] <= #2[[1,1]]])&]; poblist = {}; i = 1; If[Length[mylist] >= 1, If[Length[mylist] == 1, poblist = mylist, While[(i < Length[mylist]), If[mylist[[i,2]] != mylist[[i+1,2]], If[(i+1) == Length[mylist], poblist = Join[poblist, {mylist[[i]], mylist[[i+1]]}]; i = i+1, poblist = Append[poblist, mylist[[i]]]]; i = i+1, poblist = Append[poblist, {Join[mylist[[i,1]], mylist[[i+1,1]]], mylist[[i,2]], Join[mylist[[i,3]], mylist[[i+1,3]]]}]; i = i+2]]]]; poblist, poblist = {}] ]; poblist = positiveobstaclelist[statlist, obslist]; posoblist = Table[poblist[[i,2]], {i, Length[poblist]}]; negoblist = Complement[obslist, posoblist]; detourcornerpts[start_, end_, poblistelement_] := Module[ {`pob1, `v1, `w1, (* `c, `norm, `straightline, *) `myline, `mytimes, `hits, `xl, `xh, `yl, `yh, `zl, `zh, `sides, `n}, pob1 = poblistelement; v1 = start; w1 = end; (* c = 1/4; norm[u_] := Sqrt[u[[1]]^2+u[[2]]^2+u[[3]]^2]; straightline[s_,x_,y_] := x+s*(y-x)/norm[y-x]; *) myline[t_] := straightline[t,v1,w1]; mytimes = pob1[[1]]; hits = pob1[[3]]; xl = pob1[[2,1,1]]; xh = pob1[[2,2,1]]; yl = pob1[[2,1,2]]; yh = pob1[[2,2,2]]; zl = pob1[[2,1,3]]; zh = pob1[[2,2,3]]; sides = {}; n = Length[pob1[[3]]]; Do[ Which[ ((Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]]) && (Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]])), sides = Append[sides, {1,1}], ((Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]]) && (Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]])), sides = Append[sides, {1,2}], ((Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]])), sides = Append[sides, {1,3}], ((Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]]) && (Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]] <= Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]])), sides = Append[sides, {2,1}], ((Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]]) && (Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]] <= Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]])), sides = Append[sides, {2,2}], ((Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,1,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,1,2]]-pob1[[3,i,2]]]]) && (Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,1,3]]-pob1[[3,i,3]]]]) && (Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,2,1]]-pob1[[3,i,1]]]]) && (Abs[N[pob1[[2,2,3]]-pob1[[3,i,3]]]] <= Abs[N[pob1[[2,2,2]]-pob1[[3,i,2]]]])), sides = Append[sides, {2,3}] ], {i, n} ]; If[Length[sides] == 2, Which[ (sides[[1,2]] == 1) && (sides[[2]] == {1,2}), {{myline[mytimes[[1]]-c][[1]], yl-c, hits[[2,3]]}}, (sides[[1,2]] == 1) && (sides[[2]] == {2,2}), {{myline[mytimes[[1]]-c][[1]], yh+c, hits[[2,3]]}}, (sides[[1,2]] == 1) && (sides[[2]] == {1,3}), {{myline[mytimes[[1]]-c][[1]], hits[[2,2]], zl-c}}, (sides[[1,2]] == 1) && (sides[[2]] == {2,3}), {{myline[mytimes[[1]]-c][[1]], hits[[2,2]], zh+c}}, (sides[[1,2]] == 2) && (sides[[2]] == {1,1}), {{xl-c, myline[mytimes[[1]]-c][[2]], hits[[2,3]]}}, (sides[[1,2]] == 2) && (sides[[2]] == {2,1}), {{xh+c, myline[mytimes[[1]]-c][[2]], hits[[2,3]]}}, (sides[[1,2]] == 2) && (sides[[2]] == {1,3}), {{hits[[2,1]], myline[mytimes[[1]]-c][[2]], zl-c}}, (sides[[1,2]] == 2) && (sides[[2]] == {2,3}), {{hits[[2,1]], myline[mytimes[[1]]-c][[2]], zh+c}}, (sides[[1,2]] == 3) && (sides[[2]] == {1,1}), {{xl-c, hits[[2,2]], myline[mytimes[[1]]-c][[3]]}}, (sides[[1,2]] == 3) && (sides[[2]] == {2,1}), {{xh+c, hits[[2,2]], myline[mytimes[[1]]-c][[3]]}}, (sides[[1,2]] == 3) && (sides[[2]] == {1,2}), {{hits[[2,1]], yl-c, myline[mytimes[[1]]-c][[3]]}}, (sides[[1,2]] == 3) && (sides[[2]] == {2,2}), {{hits[[2,1]], yh+c, myline[mytimes[[1]]-c][[3]]}}, (sides[[1,2]] == 1) && (sides[[2,2]] == 1), Which[ N[(((norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end])))], {{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}, {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}}, N[(((norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end])))], {{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}, {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}}, N[(((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end])))], {{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}, {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}}, N[(((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zl-c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zl-c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zl-c}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yl-c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yl-c, hits[[2,3]]}-end])) && ((norm[start-{myline[mytimes[[1]]-c][[1]],hits[[1,2]],zh+c}] + norm[{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}- {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}] + norm[{myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}-end]) <= (norm[start-{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}] + norm[{myline[mytimes[[1]]-c][[1]],yh+c, hits[[1,3]]}- {myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}] + norm[{myline[mytimes[[2]]+c][[1]],yh+c, hits[[2,3]]}-end])))], {{myline[mytimes[[1]]-c][[1]], hits[[1,2]],zh+c}, {myline[mytimes[[2]]+c][[1]], hits[[2,2]],zh+c}}], (sides[[1,2]] == 2) && (sides[[2,2]] == 2), Which[ N[(((norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])) && ((norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end])) && ((norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end])))], {{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}, {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}}, N[(((norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])) && ((norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end])) && ((norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end])))], {{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}, {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}}, N[(((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end])) && ((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end]) <= (norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])) && ((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end]) <= (norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])))], {{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}, {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}}, N[(((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end]) <= (norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zl-c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zl-c}-end])) && ((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end]) <= (norm[start-{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xl-c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xl-c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])) && ((norm[start-{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}] + norm[{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}- {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}] + norm[{hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}-end]) <= (norm[start-{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}] + norm[{xh+c,myline[mytimes[[1]]-c][[2]], hits[[1,3]]}- {xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}] + norm[{xh+c,myline[mytimes[[2]]+c][[2]], hits[[2,3]]}-end])))], {{hits[[1,1]],myline[mytimes[[1]]-c][[2]], zh+c}, {hits[[2,1]],myline[mytimes[[2]]+c][[2]], zh+c}}], (sides[[1,2]] == 3) && (sides[[2,2]] == 3), Which[ N[(((norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end])))], {{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}, {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}}, N[(((norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end])))], {{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}, {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}}, N[(((norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])))], {{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}, {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}}, N[(((norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yl-c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yl-c,myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xl-c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xl-c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])) && ((norm[start-{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}] + norm[{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}- {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}] + norm[{hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}-end]) <= (norm[start-{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}] + norm[{xh+c, hits[[1,2]],myline[mytimes[[1]]-c][[3]]}- {xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}] + norm[{xh+c, hits[[2,2]],myline[mytimes[[2]]+c][[3]]}-end])))], {{hits[[1,1]],yh+c,myline[mytimes[[1]]-c][[3]]}, {hits[[2,1]],yh+c,myline[mytimes[[2]]+c][[3]]}}] ], Which[ (sides[[1]] == {1,1}), {{xl-c, myline[mytimes[[1]]+c][[2]], myline[mytimes[[1]]+c][[3]]}}, (sides[[1]] == {2,1}), {{xh+c, myline[mytimes[[1]]+c][[2]], myline[mytimes[[1]]+c][[3]]}}, (sides[[1]] == {1,2}), {{myline[mytimes[[1]]+c][[1]], yl-c, myline[mytimes[[1]]+c][[3]]}}, (sides[[1]] == {2,2}), {{myline[mytimes[[1]]+c][[1]], yh+c, myline[mytimes[[1]]+c][[3]]}}, (sides[[1]] == {1,3}), {{myline[mytimes[[1]]+c][[1]], myline[mytimes[[1]]+c][[2]], zl-c}}, (sides[[1]] == {2,3}), {{myline[mytimes[[1]]+c][[1]], myline[mytimes[[1]]+c][[2]], zh+c}} ] ] ]; While[posoblist != {}, pob = poblist[[1]]; detourcopts = detourcornerpts[v, w, pob]; negoblist = Complement[obslist, posoblist]; myline[t_] := straightline[t,v,w]; If[ positiveobstaclelist[ N[{v,First[detourcopts]}],negoblist] == {}, detour = Join[detour,{First[detourcopts]}], detour = Join[detour, {myline[First[poblist[[1,1]]]-c], First[detourcopts]}]]; If[ positiveobstaclelist[ N[{First[detourcopts],w}], obslist] != {}, detour = Join[detour,{Last[detourcopts]}]]; alterpoblist = positiveobstaclelist[ {Last[detour],w},obslist]; If[ Length[alterpoblist] > (Length[poblist]-1), detour = Append[detour, myline[Last[poblist[[1,1]]]+c]]; poblist = Rest[poblist]; posoblist = Rest[posoblist]; v = Last[detour], obslist = Complement[obslist,{First[posoblist]}]; v = Last[detour]; poblist = alterpoblist; posoblist = Table[poblist[[i,2]], {i, Length[poblist]}]] ]; detour = Append[detour,w]; upgrade[ldetour_] := Module[ {detourtemp,newdetour,remdetour,i}, detourtemp = ldetour; newdetour = {ldetour[[1]]}; While[Last[newdetour] != Last[ldetour], remdetour = {}; i = 0; While[ positiveobstaclelist[ {Last[newdetour], detourtemp[[Length[detourtemp]-i]]}, N[obstaclelist]] != {}, remdetour = Prepend[remdetour,detourtemp[[Length[detourtemp]-i]]]; i = i+1]; newdetour = Append[newdetour,detourtemp[[Length[detourtemp]-i]]]; detourtemp = remdetour]; newdetour]; detour = upgrade[detour] ]; detourlist[mystationlist_, myobstaclelist_] := Module[{`mydetour, `i}, mydetour = detourlist[ {mystationlist[[1]],mystationlist[[2]]}, myobstaclelist]; i = 2; While[i < Length[mystationlist], mydetour = Join[mydetour, Rest[detourlist[ {mystationlist[[i]],mystationlist[[i+1]]}, myobstaclelist]]]; i = i+1]; mydetour]; detour = detourlist[N[newstationlist], N[obstaclelist]]; myposition[t_,statlist_] := Module[{(* `norm, *) `v,`ti,`n,`marker}, (* norm[v_] := Sqrt[v[[1]]^2+v[[2]]^2+v[[3]]^2]; *) ti[1] = 0; ti[n_] := (norm[statlist[[n]]-statlist[[n-1]]])+ti[n-1]; marker = Last[Select[ Table[j,{j,1,(Length[statlist])}], ((N[ti[#]<=t])&)]]; Which[ marker < Length[statlist], statlist[[marker]]+ (t-ti[marker])* (statlist[[marker+1]]-statlist[[marker]])/ norm[(statlist[[marker+1]]-statlist[[marker]])], marker == (Length[statlist]), statlist[[marker]] ] ]; (* norm[v_] := Sqrt[v[[1]]^2+v[[2]]^2+v[[3]]^2]; *) stationsgr[statlistl_] := Table[ {PointSize[0.03],RGBColor[1,0,0], Point[statlistl[[j]]]}, {j,1,Length[statlistl]}]; stationsgraph = stationsgr[newstationlist]; obstaclesgr[obstaclelistl_] := Table[Cuboid[obstaclelistl[[k,1]], obstaclelistl[[k,2]]], {k,1,Length[obstaclelistl]}]; obstaclesgraph = obstaclesgr[obstaclelist]; cornersgr[diml_(* dimlocal *)] := {{PointSize[0.0000001],Point[{-diml,-diml,-diml}]}, {PointSize[0.0000001],Point[{-diml,diml,-diml}]}, {PointSize[0.0000001],Point[{diml,diml,-diml}]}, {PointSize[0.0000001],Point[{diml,-diml,-diml}]}, {PointSize[0.0000001],Point[{-diml,-diml,diml}]}, {PointSize[0.0000001],Point[{-diml,diml,diml}]}, {PointSize[0.0000001],Point[{diml,diml,diml}]}, {PointSize[0.0000001],Point[{diml,-diml,diml}]}}; dim = N[Max[Abs[Join[obstaclelist,detour]]]] + 1; cornersgraph = cornersgr[dim]; totaltime = N[Sum[norm[detour[[h+1]]-detour[[h]]], {h,1,(Length[detour]-1)}]]; Do[ Show[GraphicsArray[{ Graphics3D[Join[{{PointSize[0.02], RGBColor[0,0,1], Point[myposition[i,detour]]}}, stationsgraph, obstaclesgraph, cornersgraph ], ViewPoint -> {1.180, -4+i*8/totaltime, -1.0}, PlotLabel -> {PaddedForm[N[i,4],{4,2}], PaddedForm[N[totaltime,4],{4,2}]} ], Graphics3D[Join[{{PointSize[0.02], RGBColor[0,0,1], Point[myposition[i,detour]]}, stationsgraph, obstaclesgraph, cornersgraph, Play[ Sin[2 Pi 440 t 2^(1-i/totaltime)] + Sin[2 Pi 440 t], {t,0,step}, DisplayFunction->Identity][[1]] } ], ViewPoint->{0.060, 1.130, 4.000}, PlotLabel -> PaddedForm[ N[myposition[i,detour],4],{4,2}] ] }]], {i, 0, totaltime, step} ]; Show[GraphicsArray[{ Graphics3D[Join[{{PointSize[0.02], RGBColor[0,0,1], Point[myposition[totaltime,detour]]}}, stationsgraph, obstaclesgraph, cornersgraph ], ViewPoint -> {1.180, 4, -1.0}, PlotLabel -> {PaddedForm[N[totaltime,4],{4,2}], PaddedForm[N[totaltime,4],{4,2}]} ], Graphics3D[Join[{{PointSize[0.02], RGBColor[0,0,1], Point[myposition[totaltime,detour]]}, stationsgraph, obstaclesgraph, cornersgraph, Play[ Sin[2 Pi 440 t], {t,0,2*step}, DisplayFunction->Identity][[1]] } ], ViewPoint->{0.060, 1.130, 4.000}, PlotLabel -> PaddedForm[ N[myposition[totaltime,detour],4],{4,2}] ] }]] ]]] ] navigate[stationlist_] := navigate[stationlist, {}] (* * Protect the function. * Since there are no private functions we do * not have to lock private functions. *) Protect[navigate]; End[];