(* SKK 2001 *)
(*
Aluksi muutama geometrinen kuvaus. Vertaa vaikka esitykseeni
Algebra ja geometria -kirjassa.
*)
peilaus[piste_,norm_,kohde_]:=
  Module[{n,h,b},
    n= norm/Sqrt[norm.norm]//N;
    h= IdentityMatrix[3] - 2 Outer[Times,n,n];
    b= piste - h.piste;
    N[kohde/.{x_,y_,z_} :> h.{x,y,z} + b]];
kierto[piste_,akssnt_,kulma_,kohde_]:=
  Module[{n,nx,u,b},
    n= akssnt/Sqrt[akssnt.akssnt]//N;
    nx= {{0,-n[[3]],n[[2]]},{n[[3]],0,-n[[1]]},{-n[[2]],n[[1]],0}};
    u= MatrixExp[kulma nx]//N;
(*
Kiertomatriisin laskeminen matriisieksponenttifunktion avulla
on toisin kuin kirjassani, mutta lopputulos on kyllä sama.
(Harjoitustehtävä: Osoita samoiksi ...)
*)
    b= piste - u.piste;
    N[kohde/.{x_,y_,z_} :> u.{x,y,z} + b]];
siirto[vekt_,kohde_]:=
  Module[{},N[kohde/.{x_,y_,z_} :> {x,y,z} + vekt]];
(*
Listaan elem kerätään komennolla AppendTo perättäiset
grafiikkaelementit:
*)
elem= {};
pst= Table[{Cos[2 k Pi/5],Sin[2 k Pi/5],0},{k,0,5}]//N;
AppendTo[elem,Polygon[pst]];
Do[AppendTo[elem,peilaus[pst[[k]],pst[[k]]+pst[[k+1]],elem[[1]]]/.
  Polygon[ls_]:>Polygon[Reverse[ls]]],
  {k,1,5}];
(*
Lasketaan dodekaedrin alaosan sivutahkoja ylös kierrettäessä
tarvittavat kulmat:
*)
ervekt= kierto[pst[[1]],pst[[2]]-pst[[1]],fi,pst[[3]]]-
  kierto[pst[[2]],pst[[3]]-pst[[2]],fi,pst[[1]]];
kulmartk= FindRoot[ervekt.ervekt==0,{fi,2}];
kulma= Pi - fi - 0.001 /.First[kulmartk]//Chop;
(*
Alakärkeä ja yläkärkeä tarvitaan myöhemmin yhdistettäessä
dodekaedrin ala- ja yläosa.
*)
alakarki=
  kierto[pst[[1]],pst[[2]]-pst[[1]],fi,pst[[3]]]/.First[kulmartk]//Chop;
ylakarki=
  kierto[pst[[1]],pst[[2]]-pst[[1]],fi,pst[[4]]]/.First[kulmartk]//Chop;
Do[AppendTo[elem,Table[
  kierto[pst[[j]],pst[[j]]-pst[[j+1]],k kulma/10,elem[[j+1]]],{j,1,5}]],
  {k,0,10}];
AppendTo[elem,elem[[{1,17}]]];
d= 2;
siirtovekt= {0,0,ylakarki[[3]] + 2 (d - ylakarki[[3]]) - alakarki[[3]]};
AppendTo[elem,peilaus[{0,0,d},{0,0,1},elem[[18]]]/.
  Polygon[ls_]:>Polygon[Reverse[ls]]];
Do[AppendTo[elem,kierto[{0,0,0},{0,0,1},k Pi/25,elem[[19]]]],
  {k,0,5}];
Do[AppendTo[elem,siirto[- k siirtovekt/5,elem[[25]]]],
  {k,0,5}];
(*
Perättäiset kuvat muodostetaan keräämällä kuhunkin kuvaan
sopivat grafiikkaelementit. Seuraavasta listasta ilmenee,
mitkä elementit kuuluvat kuhunkin kuvaan. Esimerkiksi
kuvassa 5 on elementit 1, 2 ja 3.
*)
kuvalista= {
  {1},
  {1},
  {1},
  {1,2},
  {1,2,3},
  {1,2,3,4},
  {1,2,3,4,5},
  {1,2,3,4,5,6},
  {1,7},
  {1,8},
  {1,9},
  {1,10},
  {1,11},
  {1,12},
  {1,13},
  {1,14},
  {1,15},
  {1,16},
  {1,17},
  {18},
  {18,19},
  {18,20},
  {18,21},
  {18,22},
  {18,23},
  {18,24},
  {18,25},
  {18,26},
  {18,27},
  {18,28},
  {18,29},
  {18,30},
  {18,31},
  {18,31},
  {18,31},
  {18,31}
};
(*
Näytetään kuvat yhtenä taulukkona. Tämän animointi Mathematicassa
napauttamalla taulukon hakanen aktiiviseksi ja näppäilemällä
ctrl-y.
*)
kuvat= Table[Show[
  Graphics3D[{EdgeForm[{GrayLevel[0.5],Thickness[0.007]}],
  FaceForm[RGBColor[0,1,1],RGBColor[1,1,0]],
  elem[[kuvalista[[k]]]]}],
  Boxed->False,PlotRange->{{-3,3},{-3,3},{-1,5}},
  ImageSize->{600,600},Lighting->False],
  {k,1,Length[kuvalista]}];