
(*   Potraga za Desarguesovim konfiguracijama   *)

(*   Vedran Krcadinac, Travanj 1996.  *)

(*   Varijabli Ravnina treba pridruziti projektivnu ravninu, 
     a varijabli Red njezin red                               *)


(*  Ako se projektivna ravnina konstruira pomocu paketa FinitePlanes.m
    ili HughesPlanes.m ovo je definicija za Red:                        *)

Red := FFOrder


(* Osnovne operacije u Ravnini *)

Sijeci[a_,b_] := 
  If[a==b,Message[Sijeci::isti]; $Failed, 
          Intersection[Ravnina[[a]],Ravnina[[b]]][[1]]] 

Sijeci::isti = 
  "Pokusaj sijecenja pravca sa samim sobom."

Spoji[A_,B_] :=
  If[A==B,Message[Spoji::isti]; $Failed,
          Position[Ravnina, x_ /; MemberQ[x,A] && MemberQ[x,B],{1}][[1,1]]]

Spoji::isti =
  "Pokusaj spajanja tocke sa samom sobom."

Niz[a_] := Ravnina[[a]]

Pramen[A_] := Flatten[Position[Ravnina, x_ /; MemberQ[x,A],{1}]]


(* Provjera da li se za zadane tocke i pravce zatvara Desarguesova
   konfiguracija                                                    *)

ZatvaraSe[o_,O_,t1_,t2_,t3_,A1_,A2_,B_,C_] :=
  Module[{T1,T2,B2,C2,S1,S2},
         T1 = Sijeci[o,Spoji[A1,B]];
         T2 = Sijeci[o,Spoji[A2,C]];
         B2 = Sijeci[t2,Spoji[T1,A2]];
         C2 = Sijeci[t3,Spoji[T2,A1]];
         S1 = Sijeci[o,Spoji[B,C2]];
         S2 = Sijeci[o,Spoji[B2,C]];
         S1 == S2 
        ]


(* Na slucajan nacin odaberi BrojPonavljanja puta elemente za
   pravac o i tocku O, te provjeri da li se zatvaraju Desarguesove
   konfiguracije. Ako se to ne desi, vrati False ( i eventualno
   Protuprimjer), a ako se konfiguracija zatvori svaki puta vrati True  *)

SlProbaj[o_,O_,opcije___] :=
  Module[{x,t,tt1,tt2,tt3,AA1,AA2,BB,CC,zatv,i},
  If[Not[MemberQ[Niz[o],O]],Message[SlProbaj::nisuinc,o,O]; $Failed,
     t = Complement[Pramen[O],{o}];
     kraj = BrojPokusaja /. {opcije} /. Options[SlProbaj];
     zatv = True; i = 1;
     While[ zatv && i <= kraj , ++i;
     tt1=t[[ Random[Integer,{1,Red}] ]];
     tt2=Complement[t,{tt1}] [[ Random[Integer,{1,Red-1}] ]];
     tt3=Complement[t,{tt1,tt2}] [[ Random[Integer,{1,Red-2}] ]];
     AA1=Complement[Niz[tt1],{O}] [[ Random[Integer,{1,Red}] ]];
     AA2=Complement[Niz[tt1],{O,AA1}][[ Random[Integer,{1,Red-1}] ]];
     BB =Complement[Niz[tt2],{O}] [[ Random[Integer,{1,Red}] ]];
     CC =Complement[Niz[tt3],{O}] [[ Random[Integer,{1,Red}] ]];
     zatv = ZatvaraSe[o,O,tt1,tt2,tt3,AA1,AA2,BB,CC]
	   ];
     If[zatv,True,
      If[Protuprimjer /. {opcije} /. Options[SlProbaj],
         {False,{t1->tt1,t2->tt2,t3->tt3,A1->AA1,A2->AA2,B->BB,C->CC}},
	 False]
       ]
    ] 
 ] 

Options[SlProbaj] = {BrojPokusaja -> 3,Protuprimjer -> False}

SlProbaj::nisuinc = "Tocka `2` nije incidentna s pravcem `1`.";


(* Provjeri da li je pravac o translacijski. Ako nije, vratit ce se 
   False i eventualno protuprimjer. Ako funkcija vrati Probably
   pravac je najvjerojatnije translacijski                            *)

TransPravac[o_,opcije___] :=
  Module[{niz,i,radi,OO,rez},
	 niz = Niz[o];
	 i = 0; radi = True;
	 While[radi && i <= Red, ++i;
	       OO = niz[[i]];
	       rez = SlProbaj[o,OO,opcije];
	       If[Length[rez]==0,radi = rez,radi=False]
              ];
         If[radi,Probably,
	    If[Length[rez]==0,False,
	       {False,Join[{O->OO},rez[[2]]]}
              ]
           ]  
        ]


(* Provjeri da li je tocka O translacijska. Ako nije, vratit ce se 
   False i Protuprimjer (ako ga zelite). Ako funkcija vrati Probably
   tocka je najvjerojatnije translacijska                             *)

TransTocka[O_,opcije___] :=
  Module[{pramen,i,radi,oo,rez},
	 pramen = Pramen[O];
	 i = 0; radi = True;
	 While[radi && i <= Red, ++i;
	       oo = pramen[[i]];
	       rez = SlProbaj[oo,O,opcije];
	       If[Length[rez] == 0,radi=rez,radi=False]
              ];
        If[radi,Probably,
	   If[Length[rez]==0,False,
	      {False,Join[{o->oo},rez[[2]]]}
             ]
          ]
        ]


(*  Analiza Ravnine. Provjerava se koji su pravci i tocke translacijski,
    a koji nisu                                                           *) 

Analiza :=
 Module[{v,sve,trto,trpr,pjesu,tjesu,pravilo},
	v = Red^2 +Red+1;
	sve = Table[i,{i,1,v}];
	trto = Map[TransTocka,sve];
	trpr = Map[TransPravac,sve];
	pravilo = x_Integer :> ToString[x] <> " ";
        pjesu = StringJoin[Flatten[Position[trpr,Probably]] /. pravilo];
        tjesu = StringJoin[Flatten[Position[trto,Probably]] /. pravilo];
	{"  Kandidati za translacijske tocke: "<>tjesu<>". Ostale tocke nisu translacijske.",
	 "  Kandidati za translacijske pravce: "<>pjesu<>". Ostali pravci nisu translacijski."
        }
       ]

