(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2"; MacintoshStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times"; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times"; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times"; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times"; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times"; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times"; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = input, noPageBreakInGroup, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier"; fontset = output, output, inactive, noPageBreakInGroup, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = message, inactive, noPageBreakInGroup, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier"; fontset = print, inactive, noPageBreakInGroup, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier"; fontset = info, inactive, noPageBreakInGroup, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier"; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier"; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva"; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = leftheader, inactive, L2, 12, "Times"; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times"; fontset = leftfooter, inactive, L2, 12, "Times"; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times"; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times"; paletteColors = 4096; useSolids; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; startGroup] Chexagons :[font = text; inactive; preserveAspect] Chexagons is the fanciful shorthand for "cortical hexagons," a conjectured structure for visual processing in the human brain. For more extensive discussion of chexagons, consult the following papers: Watson, A. B. (1989). Recursive, in-place algorithm for the hexagonal orthogonal oriented quadrature image pyramid. Proceedings of the SPIE 1099, 194-200. Watson, A. B. & Ahumada, A. J., Jr. (1987). An orthogonal oriented quadrature hexagonal image pyramid NASA Technical Memorandum 100054. Watson, A. B. & Ahumada, A. J., Jr. (1989). A hexagonal orthogonal oriented pyramid as a model of image representation in visual cortex. IEEE Trans. Biomed. Eng. 36(1), 97-106. Also reprinted in M. M. G. a. G. K. Knopf (Ed.), Neuro-vision systems: principles and applications, New York: IEEE Press. Watson, A. B. (1991). Cortical Algotecture. In C. B. Blakemore (Ed.), Vision: Coding and efficiency, Cambridge: Cambridge University Press. :[font = subsection; inactive; Cclosed; preserveAspect; startGroup] old stuff :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] done :[font = input; inactive; preserveAspect] % hexagonal sampling, red/green/blue /depth 0 def /maxdepth 3 def % maximum levels /latticeRot 3 sqrt 5 atan def% lattice rotation angle /root7 1 7 sqrt div def% scale change between levels /negrot {/latticeRot latticeRot neg def} def /down {/depth depth 1 add def } def % increments depth /up {/depth depth 1 sub def } def % decrements depth /inch {72 mul} def % scale to inches /redon 1 def /greenon 0 def /swapcolor { /redon 1 redon sub def /greenon 1 greenon sub def redon greenon 0 setrgbcolor } def :[font = input; inactive; preserveAspect] /vertex% angle is on stack% go to vertex at angle, draw hexagon pyramid {/angle exch def gsave angle rotate 1 0 translate angle neg rotate fracthex grestore } def :[font = input; inactive; preserveAspect] /hexside % draw one side of a hexagon {60 rotate 1 0 lineto currentpoint translate } def /drawhex % draw unit hexagon { gsave -60 rotate 1 0 moveto 60 rotate% move to first vertex currentpoint translate 5 { hexside } repeat% draw 5 sides closepath % draw sixth side gsave rollcolor % swapcolor fill grestore stroke grestore } def :[font = input; inactive; preserveAspect] /fracthex % draw hexagon pyramid {gsave root7 dup scale% reduce scale by root 7 2 72 div setlinewidth down negrot latticeRot rotate drawhex% move down one level, rotate lattice, draw hex depth maxdepth le % test if at max level {fracthex % recursive call to fracthex 0 60 300 { vertex } for % call vertex at each vertex } if up negrot grestore } def :[font = input; inactive; preserveAspect; endGroup] showpage %(Elapsed time) showSTATUS :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] not done :[font = input; inactive; preserveAspect; endGroup] /color [1 0 0] def /rollcolor { /color [color aload pop 3 1 roll] def color aload pop setrgbcolor } def gsave% main program 4.25 inch 5.5 inch moveto currentpoint translate 6 inch 6 inch scale latticeRot neg rotate 1 setlinejoin 0 0 0 setrgbcolor fracthex grestore 1 inch 1 inch moveto %/Palatino-Roman findfont 34 scalefont setfont %(Chexagon Pyramid) show :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] code :[font = input; inactive; preserveAspect] init[mdepth_:1] := ( depth=0; maxdepth=mdepth; rot = ArcTan[3 Sqrt[5]]; root7 = 1/Sqrt[7]; glist={}; scale=1; loc={0,0}; angle=0; ) :[font = input; inactive; preserveAspect] down[] := depth += 1 :[font = input; inactive; preserveAspect] up[] := depth -= 1 :[font = input; inactive; preserveAspect] negrot[] := rot *= -1 :[font = input; inactive; preserveAspect; startGroup] rot :[font = output; output; inactive; preserveAspect; endGroup] ArcTan[3*5^(1/2)] ;[o] ArcTan[3 Sqrt[5]] :[font = input; inactive; preserveAspect; startGroup] negrot[] :[font = output; output; inactive; preserveAspect; endGroup] -ArcTan[3*5^(1/2)] ;[o] -ArcTan[3 Sqrt[5]] :[font = input; inactive; preserveAspect] vertex[vangle_] := ( gsave[]; angle += vangle; loc += Rotate2D[{scale,0},angle]; angle -= vangle; fracthex[]; grestore[];) :[font = input; inactive; preserveAspect] gsave[] := ( oldloc = loc; oldscale = scale; oldangle = angle;) :[font = input; inactive; preserveAspect] grestore[]:= ( loc = oldloc; scale = oldscale; angle = oldangle;) :[font = input; inactive; preserveAspect; endGroup] fracthex[] := ( gsave[]; scale = root7 scale; down[]; negrot[]; angle = angle + rot; glist = {glist,hex[loc,scale,angle,colors[[depth]]]}; If[depth <= maxdepth, (fracthex[]; Do[vertex[x Degree],{x,0,300,60}]) ]; up[]; negrot[]; grestore[]; ) :[font = subsubsection; inactive; Cclosed; preserveAspect; startGroup] new version :[font = input; inactive; preserveAspect] colors = {{1,0,0},{0,1,0},{0,0,1},{1,0,1}}; :[font = input; inactive; preserveAspect] main[start_] := ( glist={}; cloc={0,0}; level=start; descend[]; glist) :[font = input; inactive; preserveAspect] descend[] := ( loc=cloc; level--; If[level>0, (descend[]; Do[branch[i],{i,6}]; cloc=loc;) ]; transform[]; level++; ) :[font = input; inactive; preserveAspect] branch[node_] := ( cloc += off[level,node]; descend[]; ) :[font = input; inactive; preserveAspect] off[level_,node_] := Rotate2D[7^(level/2) dc[[node]],level ArcTan[3 Sqrt[5]]] :[font = input; inactive; preserveAspect] transform[] := glist = {glist,hex[loc,7^(level/2),0,colors[[level+1]]]} :[font = input; inactive; preserveAspect] (ch=Join[{{0,0}},Coords[Hexagon]])//TableForm :[font = input; inactive; preserveAspect] Show[Graphics[Line[ch]]]; :[font = input; inactive; preserveAspect] (dc = ch - ReplacePart[RotateRight[ch],{0,0},1])//TableForm :[font = input; inactive; preserveAspect] Show[Graphics[Line[Table[Plus @@ Take[dc,i],{i,7}]]]]; :[font = input; inactive; preserveAspect; endGroup; endGroup] Show[main[2],Frame->True] :[font = subsection; inactive; preserveAspect; startGroup] newer version :[font = subsubsection; inactive; preserveAspect; startGroup] draw a hexagon :[font = input; initialization; preserveAspect] *) Needs["Geometry`Polytopes`"] (* :[font = input; initialization; preserveAspect] *) Needs["Geometry`Rotations`"] (* :[font = input; initialization; preserveAspect] *) SetOptions[Graphics,AspectRatio->Automatic]; (* :[font = input; preserveAspect; startGroup] hc = Coords[Hexagon]//N :[font = output; output; inactive; preserveAspect; endGroup] {{0.5, 0.866025403784439}, {-0.5, 0.866025403784439}, {-1., 0}, {-0.5, -0.866025403784439}, {0.5, -0.866025403784439}, {1., 0}} ;[o] {{0.5, 0.866025}, {-0.5, 0.866025}, {-1., 0}, {-0.5, -0.866025}, {0.5, -0.866025}, {1., 0}} :[font = input; initialization; preserveAspect] *) hex[loc_:{0,0},scale_:1,angle_:0,color_:{1,0,1}] := Graphics[{RGBColor @@ color,Polygon[loc+Rotate2D[#,angle]& /@ (scale {{0.5, 0.866025403784439}, {-0.5, 0.866025403784439}, {-1., 0}, {-0.5, -0.866025403784439}, {0.5, -0.866025403784439}, {1., 0}})]}] (* :[font = input; preserveAspect; endGroup] Show[hex[{0,0},1,0,{1,0,0}],Frame->True]; :[font = subsubsection; inactive; preserveAspect; startGroup] chexagon :[font = input; initialization; preserveAspect] *) vsum[e_,v_] := e +#& /@ v (* :[font = input; initialization; preserveAspect] *) chexagon::usage="chexagon[max,acolors]: draw a chexagon pyramid to level max with levels colored by acolors (a list of rgb triples of length max). If acolors is Null (chexagon[max,]), then random colors will be selected. The chexagon is a Graphics object displayed with the Show[] command. Becautious with the value of max. A value of 3 takes about 2.5 seconds on an SGI Onyx RS4000. Timings will go up by a factor of 7 with each step in max"; (* ;[s] 11:0,1;73,0;76,1;100,0;107,1;141,0;144,1;150,0;157,1;438,0;441,1;444,-1; 2:5,13,10,Courier,1,12,0,0,0;6,13,10,Courier,0,12,0,0,65535; :[font = input; preserveAspect; startGroup] ArcTan[3 Sqrt[5]] Degree//N :[font = output; output; inactive; preserveAspect; endGroup] 81.5212868529138 ;[o] 81.5213 :[font = input; preserveAspect; startGroup] Degree//N :[font = output; output; inactive; preserveAspect; endGroup] 0.0174532925199433 ;[o] 0.0174533 :[font = input; preserveAspect; startGroup] Pi/180//N :[font = output; output; inactive; preserveAspect; endGroup] 0.0174532925199433 ;[o] 0.0174533 :[font = input; preserveAspect; startGroup] ArcTan[Sqrt[3]/5] /Degree//N :[font = output; output; inactive; preserveAspect; endGroup] 19.10660535086909 ;[o] 19.1066 :[font = input; initialization; preserveAspect] *) chexagon[max_,acolors_] := Module[ {angle,glist,hlist,colors,ch}, glist = {{0,0}}; hlist = {}; angle = ArcTan[Sqrt[3]/5]//N; ch = Join[{{0,0}},Coords[Hexagon]]//N; colors = If[acolors==Null, Table[Random[Real,{0,1}],{max},{3}] ,acolors]; Do[ langle = Mod[level,2] angle; hlist = {hlist,hex[#,7^(-level/2), langle, colors[[level]]]& /@ glist}; glist = Flatten[vsum[#,Rotate2D[#, langle]& /@ ((7^(-level/2)) ch)]& /@ glist, 1]; ,{level,max}]; hlist] (* :[font = input; preserveAspect] Timing[Show[chex[3,]]] :[font = input; preserveAspect; startGroup] Table[Mod[x,2],{x,10}] :[font = output; output; inactive; preserveAspect; endGroup; endGroup] {1, 0, 1, 0, 1, 0, 1, 0, 1, 0} ;[o] {1, 0, 1, 0, 1, 0, 1, 0, 1, 0} :[font = subsubsection; inactive; preserveAspect; startGroup] Example :[font = input; preserveAspect; startGroup] Timing[Show[chexagon[4,]]] :[font = output; output; inactive; preserveAspect; endGroup] {12.81999999999971*Second, Graphics["<<>>"]} ;[o] {12.82 Second, -Graphics-} :[font = input; preserveAspect; startGroup] Timing[Show[chexagon[5,]]] :[font = output; output; inactive; preserveAspect; endGroup; endGroup; endGroup; endGroup] {121.2800000000006*Second, Graphics["<<>>"]} ;[o] {121.28 Second, -Graphics-} ^*)