Re: ZigZag matrix rearrange
- To: mathgroup at smc.vnet.net
- Subject: [mg99077] Re: ZigZag matrix rearrange
- From: Ray Koopman <koopman at sfu.ca>
- Date: Sun, 26 Apr 2009 01:39:01 -0400 (EDT)
- References: <gsuit1$dsc$1@smc.vnet.net>
On Apr 25, 1:50 am, "Serych Jakub" <Ser... at panska.cz> wrote: > Dear community, > I'm trying to rearrange 8 x 8 matrix of numbers in ZigZag manner (as it is > used in JPEG comprimation algorithmhttp://en.wikipedia.org/wiki/Jpeg). > > I have created function which does it without problems, but it does it "by > hand" and it seems to me, that it could be done by some more elegant > algorithm. > Does somebody have any idea, how to do it more elegantly? > > My attempt: > zigzag[t_] := { > t[[1, 1]], > t[[1, 2]], t[[2, 1]], > t[[3, 1]], t[[2, 2]], t[[1, 3]], > t[[1, 4]], t[[2, 3]], t[[3, 2]], t[[4, 1]], > t[[5, 1]], t[[4, 2]], t[[3, 3]], t[[2, 4]], t[[1, 5]], > t[[1, 6]], t[[2, 5]], t[[3, 4]], t[[4, 3]], t[[5, 2]], t[[6, 1]], > t[[7, 1]], t[[6, 2]], t[[5, 3]], t[[4, 4]], t[[3, 5]], t[[2, 6]], > t[[1, 7]], > t[[1, 8]], t[[2, 7]], t[[3, 6]], t[[4, 5]], t[[5, 4]], t[[6, 3]], > t[[7, 2]], t[[8, 1]], > t[[8, 2]], t[[7, 3]], t[[6, 4]], t[[5, 5]], t[[4, 6]], t[[3, 7]], > t[[2, 8]], > t[[3, 8]], t[[4, 7]], t[[5, 6]], t[[6, 5]], t[[7, 4]], t[[8, 3]], > t[[8, 4]], t[[7, 5]], t[[6, 6]], t[[5, 7]], t[[4, 8]], > t[[5, 8]], t[[6, 7]], t[[7, 6]], t[[8, 5]], > t[[8, 6]], t[[7, 7]], t[[6, 8]], > t[[7, 8]], t[[8, 7]], > t[[8, 8]]}; > > Thanks for any idea > > Jakub zz[n_Integer?Positive] := Module[{s = If[OddQ@#,1,-1]&}, Abs[Rest/@Sort@Flatten[Table[{i+j,i*s[i+j],j*s[i+j]},{i,n},{j,n}],1]]] zz[8] {{1,1}, {1,2},{2,1}, {3,1},{2,2},{1,3}, {1,4},{2,3},{3,2},{4,1}, {5,1},{4,2},{3,3},{2,4},{1,5}, {1,6},{2,5},{3,4},{4,3},{5,2},{6,1}, {7,1},{6,2},{5,3},{4,4},{3,5},{2,6},{1,7}, {1,8},{2,7},{3,6},{4,5},{5,4},{6,3},{7,2},{8,1}, {8,2},{7,3},{6,4},{5,5},{4,6},{3,7},{2,8}, {3,8},{4,7},{5,6},{6,5},{7,4},{8,3}, {8,4},{7,5},{6,6},{5,7},{4,8}, {5,8},{6,7},{7,6},{8,5}, {8,6},{7,7},{6,8}, {7,8},{8,7}, {8,8}} zz[m_List /; ArrayDepth@m > 1 && Equal@@Take[Dimensions@m,2] ] := Extract[m,zz@Length@m] t = Table["t"<>ToString[10i+j],{i,8},{j,8}] {{t11,t12,t13,t14,t15,t16,t17,t18}, {t21,t22,t23,t24,t25,t26,t27,t28}, {t31,t32,t33,t34,t35,t36,t37,t38}, {t41,t42,t43,t44,t45,t46,t47,t48}, {t51,t52,t53,t54,t55,t56,t57,t58}, {t61,t62,t63,t64,t65,t66,t67,t68}, {t71,t72,t73,t74,t75,t76,t77,t78}, {t81,t82,t83,t84,t85,t86,t87,t88}} zz[t] {t11, t12,t21, t31,t22,t13, t14,t23,t32,t41, t51,t42,t33,t24,t15, t16,t25,t34,t43,t52,t61, t71,t62,t53,t44,t35,t26,t17, t18,t27,t36,t45,t54,t63,t72,t81, t82,t73,t64,t55,t46,t37,t28, t38,t47,t56,t65,t74,t83, t84,t75,t66,t57,t48, t58,t67,t76,t85, t86,t77,t68, t78,t87, t88}