(* This needs to be rewritten without hard coding and hotmap can be imported *)

(*  Permutaions of Tuples, then filtered for direction, done by hand, yielding 300 non - grey - black, rgb values for orthonormalization bases .   This is equivalent to 300 different rgb axes, all of which should have nondegenerate rows  *)

\(Tuples[{0.5, 1.0}, 3]

      {{0.5`, 0.5`, 0.5`}, {0.5`, 0.5`, 1.`}, {0.5`, 1.`, 0.5`}, {0.5`, 1.`, 
          1.`}, {1.`, 0.5`, 0.5`}, {1.`, 0.5`, 1.`}, {1.`, 1.`, 0.5`}, {1.`, 
          1.`, 1.`}}

 (*
6, 5, 4, 3, 2, 1, 
5, 4, 3, 2, 
        1
4, 3, 2, 1
3, 2, 
        1
2, 
        1, 
1

6, 10, 
        12, 12, 10, 
        6\  -> 
          56
*) 



      56\ *\ 6

      \(8!\)/\(\((8 - 
              3)\)!\)
 (*\ \ \ \ \ \ \ a\ \ \ \ \ \ \ \ \ \ \ \ b\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ c\ \ \ \ \ \ \ \ \ \ \ \ \ \ d\ \ \ \ \ \ \ \ \ \ \ \ \ e\ \ \ \ \ \ \ \ \ \ \ \ \ f\ \ \ \ \ \ \ \ \ \ \ \ g\ \ \ \ \ \ \ \ \ \ \ \ \ h\ \ \ *) 



 (*\ 
        multiples\ of\ each\ other\ can\ not\ be\ in\ the\ same\ \(pixel : \ \ {a\ , \ h}\), \ 
        no\ other\ examples\ because\ nothing\ can\ be\ doubled\ or\ halved\ to\ make\ another\ triplet; \ \ a\ and\ h\ can\ be\ thought\ of\ as\ pointing\ in\ the\ same\ \(direction\  : \ 
            gray\  - \ black\)\ *) 


      336\  - \ 6*6\ \  (*\ remove\ 6\ a, h\ permuations, \ 
        below\ *) 


      \(perms\  = 
          Join\ [
Permutations[{a, b, c}], 
            Permutations[{a, d, b}], Permutations[{a, b, e}], 
            Permutations[{a, b, f}], 
            Permutations[{a, b, 
                g}],  (*\(Permutations[{a, b, 
                  h}]\)\(,\)*) \ \ 

Permutations[{a, c, d}], 
            Permutations[{a, c, e}], Permutations[{a, c, f}], 
            Permutations[{a, c, 
                g}],  (*\(Permutations[{a, c, 
                  h}]\)\(,\)*) 

Permutations[{a, d, e}], Permutations[{a, d, f}], 
            Permutations[{a, d, 
                g}],  (*\(Permutations[{a, d, 
                  h}]\)\(,\)*) 

Permutations[{a, e, f}], 
            Permutations[{a, e, 
                g}],  (*\(Permutations[{a, e, 
                  h}]\)\(,\)*) 

Permutations[{a, f, 
                g}],  (*\(Permutations[{a, f, 
                  h}]\)\(,\)*) 

 (*\(Permutations[{a, g, 
                  h}]\)\(,\)*) 

Permutations[{b, c, d}], Permutations[{b, c, e}], Permutations[{b, c, f}], 
            Permutations[{b, c, g}], 
            Permutations[{b, c, 
                h}], 

Permutations[{b, 
                d, e}], Permutations[{b, d, f}], Permutations[{b, d, g}], 
            Permutations[{b, d, 
                h}], 

Permutations[{b, 
                e, f}], Permutations[{b, e, g}], 
            Permutations[{b, e, 
                h}], 

Permutations[{b, 
                f, g}], 
            Permutations[{b, f, 
                h}], 

Permutations[{b, 
                g, h}], 

Permutations[{c, d, e}], 
            Permutations[{c, d, f}], Permutations[{c, d, g}], 
            Permutations[{c, d, 
                h}], 

Permutations[{c, 
                e, f}], Permutations[{c, e, g}], 
            Permutations[{c, e, 
                h}], 

Permutations[{c, 
                f, g}], 
            Permutations[{c, f, 
                h}], 

Permutations[{c, 
                g, h}], 

Permutations[{d, e, f}], 
            Permutations[{d, e, g}], 
            Permutations[{d, e, 
                h}], 

Permutations[{d, 
                f, g}], 
            Permutations[{d, f, 
                h}], 

Permutations[{d, 
                g, h}], 

Permutations[{e, f, g}], 
            Permutations[{e, f, 
                h}], 

Permutations[{e, 
                g, h}], 

Permutations[{f, g, 
                h}]
];\)


      Tuples[{0.5, 1.0}, 3]

      a = {0.5`, 0.5`, 0.5`}

      b = {0.5`, 0.5`, 1.`}

      c = {0.5`, 1.`, 0.5`}

      d = {0.5`, 1.`, 1.`}

      e = {1.`, 0.5`, 0.5`}

      f = {1.`, 0.5`, 1.`}

      g = {1.`, 1.`, 0.5`}

      h = {1.`, 1.`, 1.`}


      \(MatrixForm[perms];\)

      Dimensions[perms]

      Show[Graphics[RasterArray[Apply[RGBColor, \ perms\ , {2}]]]\ , 
        ImageSize\  -> \ {600, 300}]\)

perms[[1]]    

    perms [[300, 3]]

\(\(\( (*\ \ hotmap\ import\ should\ go\ here\ *) \)\(
\)\(
\)\(
\)\(\(ramp = 
        Table[{
Piecewise[{
{1, \ 
                  1 <= i < 42}, 
{1, 
                  42 <= i < 84}, 
{Floor[5.8*\((i - 83)\)], 
                  84 <= i < 128}, 
{256, 
                  128\  <= i < 170}, 
{256, 
                  170 <= i < 212}, 
{256, 
                  212 <= i <= 
                    256}
}], 
Piecewise[{
{1, \ 1 <= i < 42}, 
{\((i - 41)\)*6, 
                  42 <= i < 84}, 
{256, 
                  84 <= i < 128}, 
{256 - \((i - 128)\)*6, 
                  128\  <= i < 170}, 
{1, 
                  170 <= i < 
                    212}, 
{Floor[\((i - 211)\)*5.7], 
                  212 <= i <= 
                    256}
}], 
Piecewise[{\ 
{Floor[i*5.8], \ 
                  1 <= i < 
                    42}, 
{256 - \((\((i - 42)\)*6)\), 
                  42 <= i < 84}, 
{1, 
                  84 <= i < 128}, 
{1, 
                  128\  <= i < 170}, 
{\((i - 169)\)*6, 
                  170 <= i < 212}, 
{256, 
                  212 <= i <= 
                    256}
}]
}, 
{i, 1, 256, 1}];\)



    ramp[\([1, All]\)] = 1\ ; \ \ \  (*\ This\ changes\ 1, 1, 5\ to\ 1, 1, 
      1\ at\ i = 
        1\ for\ the\ blue\ channel\ ; \ \ Use\ of\ All\ is\ overkill\ *) 

 (*\ i = 1; 
      While[\((i = i + 10)\) < \ 256, 
        ramp[\([i, All]\)] = 
          128]; \ \ \ This\ sets\ neutral\ gray\ every\ 10\ steps\ in\ the\ psedocolor\ scheme\ \ *) 

Export["C:\Documents and Settings\Doug\Desktop\Mathematica\pseudocolor\schroedinger3ramp.dat", 
      ramp];


    \(Clear[
        bar];\)
 (*\(bar\  = \ 
          Table[{j, \ j, \ j}, {i, 1, 10}, {j, 1, 
              256}];\)\ *) 

    \(bar\  = \ 
        Table[{j, \ j, \ j}, {i, 1, 1}, {j, 1, 256}];\)

    bar[\([1, 256]\)] = {1, 1, 1}; \ \  (*\ 
      This\ places\ black\ in\ the\ bottom\ pixel\ of\ the\ last\ \((white)\)\ column\ of\ the\ graybar\ *) 

size = 
      Dimensions[bar];

    \(height = \ size[\([1]\)];\)

    \(width\  = \ size[\([2]\)];\)

    \(depth\  = \ size[\([3]\)];\)

    \(pv1 = Table[{Part[bar, i, j, 1]}, {i, 1, height}, {j, 1, width}];\)

    \(pv3 = 
        Table[{ramp[\([pv1[\([i, j]\)]]\)]}, \ {i, 1, height}, \ {j, 1, 
            width}];\)

    \(pv4 = Flatten[pv3, 3];\)

    \(pv5 = Partition[pv4, \ width];\)

    Dimensions[pv5]

    \(pv6 = Apply[RGBColor, pv5/256, {2}];\)

    \(pv7 = RasterArray[pv6];\)

    \)\)\)

\(\(\( (*\ \(newrgbpixels = \ {{0.6, 0.4, 0.4}, {0.4, 0.6, 0.4}, {0.4, 
              0.4, 0.6}};\)\ *) \)\(
\)\( (*\ \(newrgbpixels = \ {{1.0, 0.0, 0.0}, {0.0, 1.0, 0.0}, {0.0, 0.0, 
              1.0}};\)\ *) \)\(
\)\(\(newrgbpixels = \ {{0.0, 0.0, 
            1.0}, {0.0, 1.0, 0.0}, {1.0, 0.0, 0.0}};\)

    \(MatrixForm[newrgbpixels];\)

    \(inv = Inverse[newrgbpixels];\)

    \(MatrixForm[inv];\)

    \(check = newrgbpixels\  . \ inv;\)

    \(MatrixForm[check];\)

    \(ortho\  = \ pv5 . inv;\)

    \(MatrixForm[
        ortho];\)
 (*\ \(absortho\  = \ 
          Abs[ortho]/256;\)\ \ *) \ \ \  (*\ 
      comment\ out\ absolute\ value\ \ *) 

    \(absortho\  = \ ortho/256;\)


    \(aplot = 
        Flatten[Table[{Part[absortho, 1, j, All]}, {j, 1, 256}], 
          1];\)

    Dimensions[ramp]

    Dimensions[absortho]

    Dimensions[aplot]

    {256, 3}

    {10, 256, 3}

    {256, 3}

    \(Show[
Graphics3D[
Line[
Append[ramp, 
              First[ramp]\ \  (*\ 
                Append\ needs\ to\ be\ fixed\ so\ that\ the\ first\ and\ last\ point\ are\ not\ linked\ *) 
]]], 
ImageSize\  -> \ {200, 200}, 
        AxesStyle -> RGBColor[0, 1, 0], \ 
        BoxStyle -> RGBColor[0, 1, 0]];\)\ 

    \(Show[
Graphics3D[
Line[
Append[aplot, 
              First[aplot]\ \  (*\ 
                Append\ needs\ to\ be\ fixed\ so\ that\ the\ first\ and\ last\ point\ are\ not\ linked\ *) 
]]], 
ImageSize\  -> \ {200, 200}, 
        AxesStyle -> RGBColor[0, 1, 0], \ 
        BoxStyle -> RGBColor[0, 1, 0]];\)\ 


    \(Show[
        Graphics[pv7, 
          ImageSize\  -> \ {400, 200}\ , \ \ AspectRatio -> 
            Automatic]];\)

    \(Show[Graphics[RasterArray[Apply[RGBColor, \ bar/256, {2}]]], 
        ImageSize\  -> \ {400, 200}, \ \ AspectRatio -> 
          Automatic];\)


    Show[Graphics[RasterArray[Apply[RGBColor, \ absortho\ , {2}]]], \ 
      ImageSize\  -> \ {400, 200}, \ 
      AspectRatio -> Automatic]\)\)\)

\(\(\( (*Now\ start\ making\ changes\ from\ pseudoortho\ 2\ to\ enter\ newrgbpixel\ values\ from\ \ the\ 300\ x\ 3\ matrix\ consructed\ at\ top\ *) \)\(
\)\(
\)\(newrgbpixels = \ perms[\([107]\)]


    \(inv = Inverse[newrgbpixels];\)

    \(ortho\  = \ pv5 . inv;\)
 (*\ 
      absortho\  = \ 
        Abs[ortho]/
          256; \ \ either\ comment\ out\ absolute\ value\ or\ the\ next\ line\ *) 

    \(absortho\  = \ ortho/256;\)


    \(aplot = 
        Flatten[Table[{Part[absortho, 1, j, All]}, {j, 1, 256}], 
          1];\)


    \(Show[Graphics3D[Line[Append[ramp, First[ramp]]]], 
        ImageSize\  -> \ {200, 200}, 
        AxesStyle -> RGBColor[0, 1, 0], \ 
        BoxStyle -> RGBColor[0, 1, 0]];\)\ 


    \(Show[Graphics3D[Line[Append[aplot, First[aplot]]]], 
        ImageSize\  -> \ {200, 200}, 
        AxesStyle -> RGBColor[0, 1, 0], 
        BoxStyle -> RGBColor[0, 1, 0]];\)\ 


    \(Show[
        Graphics[pv7, 
          ImageSize\  -> \ {400, 200}\ , \ \ AspectRatio -> 
            Automatic]];\)


    \(Show[Graphics[RasterArray[Apply[RGBColor, \ bar/256, {2}]]], 
        ImageSize\  -> \ {400, 200}, \ \ AspectRatio -> 
          Automatic];\)


    \(Show[Graphics[RasterArray[Apply[RGBColor, \ absortho\ , {2}]]], \ 
        ImageSize\  -> \ {400, 200}, \ 
        AspectRatio -> Automatic];\)\)\)\)

SetOptions[Graphics3D,  AmbientLight -> GrayLevel[1], 
        AspectRatio -> Automatic, Axes -> True, 
        AxesEdge -> Automatic, AxesLabel -> {x, y, z}, 
        AxesStyle -> Automatic, Background -> Automatic, 
        Boxed -> True, BoxRatios -> Automatic, 
        BoxStyle -> Automatic, ColorOutput -> Automatic, 
        DefaultColor -> RGBColor[0, 0, 0], 
        DefaultFont :> $DefaultFont, 
        DisplayFunction :> $DisplayFunction, Epilog -> {}, 
        FaceGrids -> None, FormatType :> $FormatType, 
        ImageSize -> Automatic, Lighting -> True, 
        LightSources -> {{{1.`, 0.`, 1.`}, 
              RGBColor[1, 0, 0]}, {{1.`, 1.`, 1.`}, 
              RGBColor[0, 1, 0]}, {{0.`, 1.`, 1.`}, RGBColor[0, 0, 1]}}, 
        Plot3Matrix -> Automatic, PlotLabel -> None, 
        PlotRange -> Automatic, PlotRegion -> Automatic, 
        PolygonIntersections -> True, Prolog -> {}, 
        RenderAll -> True, Shading -> True, 
        SphericalRegion -> False, TextStyle :> $TextStyle, 
        Ticks -> Automatic, ViewCenter -> Automatic, 
        ViewPoint -> {1.3`, -2.4`, 2.`}, 
        ViewVertical -> {0.`, 0.`, 1.`}];

(*For[start, test, incr, body]executesstart,then repeatedly evaluatesbodyandincruntiltestfails to giveTrue. *)

ortho  =  
      pv5 . inv;     
For[i = 1, i < 300, ortho = Join[ortho, nextortho]; 
      nextortho  =  (pv5 . (PseudoInverse[perms[[i]]]))/
          256;  i++] 

    Dimensions[perms]

    Dimensions[perms[[1]]]

    Dimensions[pv5]

    Dimensions[ortho]

gortho = 
        RasterArray[Apply[RGBColor,  ortho , {2}]];

    Show[Graphics[gortho],  ImageSize -> {300, 256}]

name = Table[i, {i, 1, 301}];

For[i = 1, i < 300, 
        ortho  =  (pv5 . (PseudoInverse[perms[[i]]]))/256; 
        gortho = 
          RasterArray[
            Apply[RGBColor,  ortho , {2}]]; 
Show[
          Graphics[gortho]]; Print[i]; 
        Export["D:\\Mathematica\\Data\\" <>  
            ToString[name[[i]]]  <>  ".gif",  
          gortho,  "GIF"];  i++];