Two Views Maze

Manipulate[
SeedRandom[ranint];With[{p1=Pravokotnik2[m,n][funk[[solid]]]},
With[{lab1=Labirint[p1,0,vie1[[solid]],vie2[[solid]],vie3[[solid]],{0,0,1},{-1,0,0}]},With[{prava=lab1[[4]],choices=Join[{0},lab1[[5]]]},Column[{Text@Row[{"find"," the length"," of the shortest "," path from first(F) to last(L) point", Spacer[15],PopupMenu[Dynamic[an],choices],"  ",If[an==prava,True,False]}],
If[!show,
Row[{ExpressionCell[lab1[[1]],Deployed->True],ExpressionCell[lab1[[2]],Deployed->True]}],Row[{ExpressionCell[lab1[[3]],Deployed->True],ExpressionCell[lab1[[2]],Deployed->True]}]]}, Alignment-> Center]]]],
Grid[{{
Control[{{solid,2,"maze"},1,3,1,SetterBar}],
 Spacer[40],

Control[{{m,5,"dimension 1"},5,8,1,SetterBar}]},{Control[{{n,6,"dimension 2"},4,9,1,SetterBar}],

 Spacer[40],
Control[{{show, False,"Help! Show top view"},{False, True}}]}}],
{{ranint,10},ControlType->None},
{an,0,ControlType->None},
Button["new maze",an=0;show=False;ranint=RandomInteger[{1,200}]],

SynchronousInitialization->False,
AutorunSequencing->{2,3},

Initialization:>(
Quiet[Needs["Combinatorica`"]];(*program za subdivizijo vej na d delov, dani so cikli*)
EdgesOnFace[lice_]:=Module[{i},(*iz cikla dobimo veje*)
Append[Table[{lice[[i]],lice[[i+1]]},{i,1,Length[lice]-1}]
,{Last[lice],First[lice]}]];
EdgesOnFaces[cic_]:=Block[{edgs={},n=Length[cic],ed,i},(*vse veje iz ciklov*)
		Do[ed=EdgesOnFace[cic[[i]]];edgs=Union[edgs,ed],
			{i,1,n}];
		edgs=Union[Map[Sort,edgs,1]]];
(*iz danih ciklov ustvari nove veje, izgleda odvec*)	
Subdivision[cic_,d_,v_,f_,e_]:=Block[{edgs,nmedges,newedgs,newed,i,newedgs1,newedgs2},
If[d==0,Return[]];
		edgs=EdgesOnFaces[cic];
	
		newedgs1=Table[{{edgs[[i]][[1]],v+d(i-1)+1},{v+i d,
					edgs[[i]][[2]]}},
			{i,1,e}];
		newedgs2=Table[{v+d(i-1)+j,v+(i-1) d+j+1},
{j,1,d-1},			{i,1,e}];
		newed=Map[Sort,Flatten[newedgs1,1],1];
newed=Sort[Union[newed,Flatten[newedgs2,1]]]];
(*glede na stare veje edgs, poisce nove to.za vrivanje nove točke vme *)
Vmesnetocke[d_,v_,edgs_,vertcoor1_][a_,b_]:=Block[{bool1,pos,vmevercovme},
		bool1=(a<b);
		{pos}=If[bool1,
		Position[edgs,{a,b}],	Position[edgs,{b,a}]];
		{vme}=Range[v+(pos-1)d+1,v+pos d];cooa=vertcoor1[[a]];
		coob=vertcoor1[[b]];
		vercovme=Table[cooa+i (coob -cooa)/(d+1),{i,1,d}];
		If[!bool1,vme=Reverse[vme];vercovme=Reverse[vercovme]];vercovme];
Vmesnetoc[d_,v_,edgs_,vertcoor1_]:=
	Block[{nm,vmes={},coo},nm=Length[edgs];
	Do[coo=
	Vmesnetocke[d,v,edgs,vertcoor1][edgs[[i]][[1]],edgs[[i]][[2]]];		
			vmes=Append[vmes,coo],
			{i,1,nm}];Flatten[vmes,1]];
	
		
(*glede na stare veje edgs, poisce nove to.za vrivanje nove točke vme *)
Vmesne[d_,v_,edgs_][a_,b_]:=Block[{bool1,pos,vme},
		bool1=(a<b);
		{pos}=If[bool1,
		Position[edgs,{a,b}],	Position[edgs,{b,a}]];
		{vme}=Range[v+(pos-1)d+1,v+pos d];
		If[!bool1,vme=Reverse[vme]];vme];
NewFace[d_,v_,edgs_][cic_]:=Block[{n=Length[cic],cic1=Join[cic,{First[cic]}],newcic={},a,b,i},
Do[a=cic1[[i ]];b=cic1[[i+1]];newcic=Join[newcic,{a},Vmesne[d,v,edgs][a,b]]{i,1,n}];newcic];
NewFaces[d_,v_,f_,e_,edgs_][cic_]:=Block[{nefaces={},i,cikel},Do[cikel=NewFace[d,v,edgs][cic[[i]]];nefaces=Append[nefaces,cikel],{i,1,f}];nefaces];		
AdjacentHI[lis_][a_,b_]:=Length[Intersection[lis[[a]],lis[[b]]]]==2;
AdjacencyPairsHI[lis_]:=Cases[Apply[Union,Table[{a,b},{a,1,Length[lis]-1},{b,a+1,Length[lis]}]],{x_,y_}/;AdjacentHI[lis][x,y]];
DodajQ[tr_,{a_,b_}]:=(MemberQ[tr,{a,x_}] && !MemberQ[tr,{y_,b}])|| (MemberQ[tr,{x_,a}] && !MemberQ[tr,{y_,b}]);
AllHI[q_][seznam_]:=Module[{flag=True},Do[If[!q[seznam[[i]]],(flag=False;Break[])],{i,1,Length[seznam]}];flag];
ExistsHI[q_][seznam_]:=Module[{flag=False},Do[If[q[seznam[[i]]],(flag=True;Break[])],{i,1,Length[seznam]}];flag];

JeNode[a_][seznam_]:=MemberQ[seznam,{a,x_}] || MemberQ[seznam,{y_,a}];
NiNode[a_][seznam_]:=Module[{flag=True},Do[If[(a==seznam[[i]][[1]] || a==seznam[[i]][[2]]),(flag=False;Break[])],{i,1,Length[seznam]}];flag];

DodajHIQ[tr_,{a_,b_}]:=(JeNode[a][tr] && NiNode[b][tr]) || (JeNode[b][tr] && NiNode[a][tr]);


MaksiTreeHIQ[tr_,n_]:=Module[{flag=True},Do[If[NiNode[i][tr],(flag=False;Break[])],{i,1,n}];flag];

TreeHI[pove_][n_][m_]:=Module[{tr={pove[[n]]}},While[!MaksiTreeHIQ[tr,m],Do[If[DodajHIQ[tr,pove[[k]]],(tr=Append[tr,pove[[k]]];Break[])],{k,1,Length[pove]}]];tr];
UrediTreeHI[drevo_]:=Module[{drev=drevo,len=Length[drevo]},Do[Do[If[drevo[[k]][[2]]==drevo[[i]][[2]],drev=ReplacePart[drev,{drevo[[k]][[2]],drevo[[k]][[1]]},k]],{i,1,k-1}],{k,2,len}];drev];
ForCycles[i_Integer,lis_List]:= Module[
		{cyc={},n=Length[lis],k},
		k=IntegerPart[n/2];
		
		Do[cyc=Append[cyc,Join[{i},Part[lis,{2 m,2 m +1,
		2 m +2}]]],{m,1,k-1}];cyc=
	   Append[cyc,Join[{i},Part[lis,{2 k,Mod[2 k +1,n],
		Mod[2 k +2,n]}]]]];
						
		
		
KorSredineCikla[vertcoor1_][cikel_]:=
Sum[vertcoor1[[cikel[[i]]]],{i,1,Length[cikel]}]/Length[cikel];
KorSredineCiklov[vertcoor1_][cikli_]:=
Table[	KorSredineCikla[vertcoor1][cikli[[i]]],{i,1,Length[cikli]}];
EdgesFromCycles[lis_List]:=Module[
		{n=Length[lis],ed={}},
		Do[
			ed=Append[ed,EdgesOnFace[lis[[i]]]],{i,1,n}];
	ed];
			
		
Povprecje[cic_]:=Apply[Plus,cic]/Length[cic];
vekprd[stiri_]:=Cross[stiri[[2]]-stiri[[1]],stiri[[3]]-stiri[[1]]];
Labirint[solid_,dd_,view_,view1_,view2_,vertical_,vertical1_]:=Block[{c1,pove,f,dre,gra,stran1,stran,pove1,m,drevo,edg,ed1,i,ran,pot1,zatt,
		alledges,lica3,tr2,cikli,urej,urejen,veje,slika1,slika2,gra1,dre1,vertcoor1,vertcoor2,vm,linijaset,maksi,maksihue,t,c1nov,povenov,fnov,drenov,granov,stran1nov,strannov,pove1nov,mnov,drevonov,edgnov,ed1nov,inov,rannov,pot1nov,zattnov,
		alledgesnov,lica3nov,tr2nov,ciklinov,vmnov,lica1,lica1nov,ii,v1,v,e,edgs},

	t=solid;d=1;
				c1=t[[1]];
		vertcoor1=t[[2]];sredina=Apply[Plus,vertcoor1];(*Print["sredina",sredina];*)
f=Length[c1];v=Length[Union[Flatten[c1]]];e=v+f-2;(*Print["e",e];*)
	edgs=EdgesOnFaces[c1];

Do[
	
				
		vm=Vmesnetoc[d,v,edgs,vertcoor1];
		
	vertcoor2=Join[vertcoor1,vm];
		vm=KorSredineCiklov[vertcoor1][c1];
		vertcoor1=Join[vertcoor2,vm];
	cikli=NewFaces[d,v,f,e,edgs][c1];
		v1=v+e;
		
	stran1=	Table[ForCycles[v1+i,cikli[[i]]],{i,1,f}];
v=v1+f;
			stran=Flatten[stran1,1];


c1=stran;
edgs=EdgesOnFaces[c1];	f=Length[stran];
e=v+f-2;,
{ii,1,dd}];stran=c1;
	
pove1=AdjacencyPairsHI[stran];g1=Combinatorica`FromUnorderedPairs[pove1];
m=Length[stran];
drevo=Combinatorica`DepthFirstTraversal[g1,Random[Integer,{1,f}],Edge];
edg={};
Do[ed1=Intersection[stran[[drevo[[i]][[1]]]],stran[[drevo[[i]][[2]]]]];edg=Append[edg,ed1],{i,1,Length[drevo]}];

	
alledges=Union[Map[Sort,EdgesOnFaces
							[stran],1]];

vejeobd=Complement[alledges,edg];


	zadnja1=Last[drevo][[2]];
	g1=Combinatorica`FromUnorderedPairs[drevo];
		prva=Last[Combinatorica`BreadthFirstTraversal[g1,zadnja1]];
			zadnja=Last[Combinatorica`BreadthFirstTraversal[g1,prva]];
		pot1=Combinatorica`ShortestPath[g1,prva,zadnja];
		prvicikel=stran[[prva]];
		zadnjicikel=stran[[zadnja]];
		solut=Length[pot1];shif=Random[Integer,{0,4}];
izpis=	{"Solution: ",solut,", Answers: ",Range[solut-shif,solut-shif+4]};	
(*Print["stran",stran];*)
vert=vertcoor1[[#]]&;zatt1=Map[Povprecje,Map[vert,stran,{1}]	];
		zatt2=	Table[vekprd[Map[vert,stran[[kkk]],{1}]],{kkk,1,Length[stran]}	] ;
indstranA=Select[Range[m],zatt2[[#]].view>0.01&];indstranB=Select[Range[m],zatt2[[#]].view<-0.01&];indstranC=Select[Range[m],zatt2[[#]].view1>0.01&];indstranD=Select[Range[m],zatt2[[#]].view1<-0.01&];indstranE=Select[Range[m],zatt2[[#]].view2>0.01&];indstranF=Select[Range[m],zatt2[[#]].view2<-0.01&];
stranA=Table[stran[[indstranA[[i]]]],{i,1,Length[indstranA]}];stranB=Table[stran[[indstranB[[i]]]],{i,1,Length[indstranB]}];stranC=Table[stran[[indstranC[[i]]]],{i,1,Length[indstranC]}];stranD=Table[stran[[indstranD[[i]]]],{i,1,Length[indstranD]}];stranE=Table[stran[[indstranE[[i]]]],{i,1,Length[indstranE]}];stranF=Table[stran[[indstranF[[i]]]],{i,1,Length[indstranF]}];
edgsA=EdgesOnFaces[stranA];edgsB=EdgesOnFaces[stranB];edgsC=EdgesOnFaces[stranC];edgsD=EdgesOnFaces[stranD];edgsE=EdgesOnFaces[stranE];edgsF=EdgesOnFaces[stranF];
vejeobdA=Intersection[vejeobd,edgsA];vejeobdB=Intersection[vejeobd,edgsB];vejeobdC=Intersection[vejeobd,edgsC];vejeobdD=Intersection[vejeobd,edgsD];vejeobdE=Intersection[vejeobd,edgsE];vejeobdF=Intersection[vejeobd,edgsF];
zatt=Povprecje[Map[vert,stran[[#]],{1}]	] &;	
		zat=zatt[prva];kont=zatt[zadnja];
slika4={Text["F",zat],Text["L",kont]};
	slika4A={Text[StyleForm[If[zatt2[[pot1[[1]]]]. view >0.05,"F",""],FontSize->10-dd],zatt[pot1[[1]]]],Text[StyleForm[If[zatt2[[pot1[[Length[pot1]]]]]. view>0.05,"L",""],FontSize->10-dd],zatt[pot1[[Length[pot1]]]]]};
slika4C={Text[StyleForm[If[zatt2[[pot1[[1]]]]. view1 >0.01,"F",""],FontSize->10-dd],zatt[pot1[[1]]]],Text[StyleForm[If[zatt2[[pot1[[Length[pot1]]]]]. view1 >0.01,"L",""],FontSize->10-dd],zatt[pot1[[Length[pot1]]]]]};

				
(*konec iskanja*)				
gr1=Transpose[{Table[GrayLevel[1],{Length[edg]}],Table[Thickness[0.004],{Length[edg]}],
							Map[Line,Map[vertcoor1[[#]]&,edg,{1}],{1}]}];				
gr2A=Transpose[{Table[Red,{Length[vejeobdA]}],Table[Thickness[0.02],{Length[vejeobdA]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdA,{1}],{1}]}];
	gr2B=Transpose[{Table[Red,{Length[vejeobdB]}],Table[Thickness[0.02],{Length[vejeobdB]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdB,{1}],{1}]}];
gr2C=Transpose[{Table[Red,{Length[vejeobdC]}],Table[Thickness[0.02],{Length[vejeobdC]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdC,{1}],{1}]}];
	gr2D=Transpose[{Table[Red,{Length[vejeobdD]}],Table[Thickness[0.02],{Length[vejeobdD]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdD,{1}],{1}]}];
gr2E=Transpose[{Table[Red,{Length[vejeobdE]}],Table[Thickness[0.02],{Length[vejeobdE]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdE,{1}],{1}]}];
	gr2F=Transpose[{Table[Red,{Length[vejeobdF]}],Table[Thickness[0.02],{Length[vejeobdF]}],
							Map[Line,Map[vertcoor1[[#]]&,vejeobdF,{1}],{1}]}];			
		gr3={SurfaceColor[GrayLevel[0.9]],EdgeForm[GrayLevel[0.6]],
      Map[Polygon,Map[vertcoor1[[#]] &,c1,1]]};

xmin=Min[Map[#[[1]]&,vertcoor1]]; xmax=Max[Map[#[[1]]&,vertcoor1]];ymin=Min[Map[#[[2]]&,vertcoor1]];ymax=Max[Map[#[[2]]&,vertcoor1]];zmin=Min[Map[#[[3]]&,vertcoor1]];zmax=Max[Map[#[[3]]&,vertcoor1]];
dx=xmax-xmin;
dy=ymax-ymin;dz=zmax-zmin;

plotrange=If[dx≥dy && dx≥dz,{{xmin,xmax},{ymin-(dx-dy)/2,ymax+(dx-dy)/2},{zmin-(dx-dz)/2,zmax+(dx-dz)/2}},If[dy≥dx && dy≥dz,{{xmin-(dy-dx)/2,xmax+(dy-dx)/2},{ymin,ymax},{zmin-(dy-dz)/2,zmax+(dy-dz)/2}},{{xmin-(dz-dx)/2,xmax+(dz-dx)/2},{ymin-(dz-dy)/2,ymax+(dz-dy)/2},{zmin,zmax}}]];
plotrange1={{plotrange[[1,1]]-0.1,plotrange[[1,2]]+0.1},{plotrange[[2,1]]-0.1,plotrange[[2,2]]+0.1},{plotrange[[3,1]]-0.1,plotrange[[3,2]]+0.1}};


	{Graphics3D[{gr2A,gr3,slika4A},AspectRatio->Automatic,ViewPoint->view,ViewVertical->vertical,ViewCenter->{0.5,0.5,0.5},Boxed->False,PlotRange->plotrange,Lighting->"Neutral",ImageSize->{240,250}],Graphics3D[{gr2C,gr3,slika4C},AspectRatio->Automatic,ViewPoint->view1,ViewVertical->vertical,ViewCenter->{0.5,0.5,0.5},Boxed->False,PlotRange->plotrange,Lighting->"Neutral",ImageSize->{240,250}],

Graphics3D[{gr2E,gr3,slika4},AspectRatio->Automatic,ViewPoint->view2,ViewVertical->vertical1,ViewCenter->{0.5,0.5,0.5},Boxed->False,PlotRange->plotrange,Lighting->"Neutral",ImageSize->{240,250}],solut,Range[solut-shif,solut-shif+4]}	
		];
PravokotniGraf2[m_,n_,v0_,vx_,vy_]:={Flatten[Table[{(j-1)m+i,(j-1)m+i+1,j m+i+1,j m+i},{j,1,n-1},{i,1,m-1}],1],Flatten[Table[v0+(i-1) vx+(j-1) vy,{j,1,n},{i,1,m}],1]};
Pravokotnik2[m_,n_][f_]:=Module[{prav=PravokotniGraf2[m,n,{0,0},{1/(m-1),0},{0,1/(n-1)}],prav1},prav1={Flatten[prav[[1]],0],Flatten[prav[[2]],0]};{prav1[[1]],Table[{prav1[[2]][[i]][[1]],prav1[[2]][[i]][[2]],f[prav1[[2]][[i]][[1]],prav1[[2]][[i]][[2]]]//N},{i,1,Length[prav1[[2]]]}]}];
funk={Sin[ Pi#1]^2&,Exp[(-Abs[3(#1-0.5)]-Abs[3(#2-0.5)])]&,Exp[(-Abs[3(#1-0.5)]-Abs[3(#2-0.25)])]+Exp[(-Abs[3(#1-0.5)]-Abs[3(#2-0.75)])]&};
vie1={{10,1,10},{10,-1,4},{10,-1,4} };
vie2={{-10,-1,10},{-10,1,4},{-10,1,4}};
vie3={{0,0,40},{0,0,10},{0,0,10}};)]

A maze in space is given by two views. Find the shortest path between two given points.

Contributed by: Izidor Hafner