Hi,
you can use JPEG itself! Here is my code, but I make no efforts to optimize it thus it can be really slow. First of all, you need define RGB to
YCbCr transform. I found very nice code
here via Mr.Wizard (up to some small correction):
With[{v1 = Developer`ToPackedArray@{16`, 128`, 128`},
m1 = Developer`ToPackedArray@{{65.481, 128.553,
24.966}, {-37.797, -74.203, 112`}, {112`, -93.786, -18.214}}},
RGBtoYCbCr[a : {_, _, _}?VectorQ] := v1 + m1.a;
RGBtoYCbCr[img_Image] := RGBtoYCbCr@ImageData[img(*,"Byte"*)];
RGBtoYCbCr[a_ /; MatchQ[Dimensions@a, {_, 3}]] :=
Transpose[v1 + m1.Transpose[a]];
RGBtoYCbCr[a_ /; MatchQ[Dimensions@a, {_, _, 3}]] :=
Transpose[v1 + m1.Transpose[a, {2, 3, 1}], {3, 1, 2}];]
Inverse transform:
With[{v1 = Developer`ToPackedArray@{-16`, -128`, -128`},
m1 = Developer`ToPackedArray@
Inverse@{{65.481, 128.553, 24.966}, {-37.797, -74.203,
112`}, {112`, -93.786, -18.214}}},
YCbCrtoRGB[a : {_, _, _}?VectorQ] := m1.(a + v1);
YCbCrtoRGB[a_ /; MatchQ[Dimensions@a, {_, 3}]] :=
Transpose[m1.(Transpose[a] + v1)];
YCbCrtoRGB[a_ /; MatchQ[Dimensions@a, {_, _, 3}]] :=
Transpose[m1.(Transpose[a, {2, 3, 1}] + v1), {3, 1, 2}];]
Then it is necessary to define the Fourier discrete cosine transform.
fnorm = Developer`ToPackedArray@
Normal@SparseArray[{{1, 1} -> 1, {i_, i_} -> Sqrt[2]}, {8, 8}];
bnorm = Developer`ToPackedArray@
Normal@SparseArray[{{1, 1} -> 1, {i_, i_} -> 1/Sqrt[2]}, {8, 8}];
ForwardDCT[matrix_] := fnorm.FourierDCT[matrix - 128, 2].fnorm;
BackwardDCT[matrix_] := 128 + FourierDCT[bnorm.matrix.bnorm, 3];
Please, notice the JPEG uses DCT in slightly different way than Wolfram Mathematica. Next step is to define the quntization tabels for all channels:
DQT["luma"] =
Developer`ToPackedArray@{{16, 11, 10, 16, 24, 40, 51, 61}, {12, 12,
14, 19, 26, 58, 60, 55}, {14, 13, 16, 24, 40, 57, 69, 56}, {14,
17, 22, 29, 51, 87, 80, 62}, {18, 22, 37, 56, 68, 109, 103,
77}, {24, 35, 55, 64, 81, 104, 113, 92}, {49, 64, 78, 87, 103,
121, 120, 101}, {72, 92, 95, 98, 112, 100, 103, 99}};
DQT["chroma"] =
Developer`ToPackedArray@{{17, 18, 24, 47, 99, 99, 99, 99}, {18, 21,
26, 66, 99, 99, 99, 99}, {24, 26, 56, 99, 99, 99, 99, 99}, {47,
66, 99, 99, 99, 99, 99, 99}, {99, 99, 99, 99, 99, 99, 99,
99}, {99, 99, 99, 99, 99, 99, 99, 99}, {99, 99, 99, 99, 99, 99,
99, 99}, {99, 99, 99, 99, 99, 99, 99, 99}};
The last step is the quntization itself:
Quantization[channel_, block_, quality_] :=
BackwardDCT[
quality DQT[channel] Round[
ForwardDCT[block]/(quality DQT[channel])]];
Now, we can start. Import an image and divide it into 8*8 blocks:
horse = Import["http://i.stack.imgur.com/ZhYwB.jpg"]
blocks = Partition[#, {8, 8}] & /@
Transpose[RGBtoYCbCr@horse, {2, 3, 1}];
Then we need to choose the quality of the output.
quality = 2;
Notice that the quality should be large than 1 and quality=1 reduces the size of the output file by factor 1.8. Thus we put a really terrible quality. The next step is quantization of each channel:
luminance[1] =
Join @@ (Join @@@ Transpose[#, {2, 1, 3}] & /@
Map[Quantization["luma", #, quality] &, blocks[[1]], {2}]);
chrominance[1] =
Join @@ (Join @@@ Transpose[#, {2, 1, 3}] & /@
Map[Quantization["chroma", #, quality] &, blocks[[2]], {2}]);
chrominance[2] =
Join @@ (Join @@@ Transpose[#, {2, 1, 3}] & /@
Map[Quantization["chroma", #, quality] &, blocks[[3]], {2}]);
This part works really slow, hence please try to optimize it. The last step is to convert to RGB and save to disk:
SetDirectory[NotebookDirectory[]];
Export["horse.jpg",
Image[YCbCrtoRGB@
Transpose[{luminance[1], chrominance[1], chrominance[2]}, {3, 1,
2}]]]
The size of the output file is 2.2 times smaler then initial one. The Mathematica file is attached to this post.
Attachments:
