Image Quality Comparator.

This notebook contains a quick application in Mathematica which presents A/B comparisons from a directory of images and stores the results. Later, it will attempt to rank them for quality overall using (basically) the HodgeRank algorithm. We start with code to pull a random image.

SourceImage := Module[{ImageName,ImPic,ShortName},
ImageName = RandomSample[FileNames["*.jpg",NotebookDirectory[] <> "SourceImages/"],1][[1]];
ImPic = ColorConvert[Import[ImageName],"Grayscale"];
ShortName = StringSplit[ImageName,"/" | "."][[-2]];
{ImPic,ShortName}
];

test = SourceImage

test[[2]]

Now we need to pull a pair of random matrices (of the same compression level).

CompressionMatrices := Module[{MatrixNames,NamePatt,ShortNames},
NamePatt = RandomSample[{"*50.dat","*90.dat","*99.dat"},1][[1]];
MatrixNames = RandomSample[FileNames[NamePatt,NotebookDirectory[] <>"Matrices/"],2];
ShortNames = StringSplit[#,"/" | "."][[-2]] & /@ MatrixNames;
Transpose[{Import /@ MatrixNames,ShortNames}]
];

cm = CompressionMatrices;

cm[[1,2]]

Now we need to copy some code from the old notebook to actually accomplish the compression. This will have to be modified to keep track of the fact that the grayscale conversion has changed the data format a little bit.

ImageToRawVectors[Img_] :=Flatten[ Map[ImageData,ImagePartition[Img,32],{2}],{{1},{2},{3,4}}];

ZeroMean[v_] := {Mean[v],v- Mean[v]};
ContrastAdjust[{μ_,v_}] := If[Max[Abs[v]] > 0.01,{μ,Max[Abs[v]],(1/Max[Abs[v]]) v},{μ,1,v}];
Preprocess[v_] := ContrastAdjust[ZeroMean[v]];

ImageToData[Img_] :={#[[;;,;;,1;;2]],#[[;;,;;,3]]}&[Map[Preprocess,ImageToRawVectors[Img],{2}]];

{TestAuxData,TestVectors} = ImageToData[test[[1]]];

ReMean[{μ_,v_}] := (# + μ)& /@ v;
DeContrast[{μ_,λ_,v_}] := {μ,λ v};
Postprocess[{AuxData_,Vectors_}] := Map[ReMean,Map[DeContrast,Map[{#[[1]],#[[2]],#[[3;;]]}&,Join[AuxData,Vectors,3],{2}],{2}],{2}];

DataToImage[{AuxData_,Vectors_}] := ImageAssemble[Map[Image,Map[Partition[#,32]&,Postprocess[{AuxData,Vectors}],{2}],{2}]];

DataToImage[{TestAuxData,TestVectors}]

Now we can write the compress and decompress functions:

CompressImage[A_,Vectors_] := Module[{APlus},
APlus = PseudoInverse[A];
Map[Flatten[APlus.Transpose[{#}]]&,Vectors,{2}]
];
DecompressImage[A_,CompressedVectors_] := Map[Flatten[A.Transpose[{#}]]&,CompressedVectors,{2}];

cvec = DecompressImage[cm[[1,1]],CompressImage[cm[[1,1]],TestVectors]];

Dimensions[cvec]

And finally assemble everything into the function which applies the transformation:

CompressedVersion[{Img_,ImgName_},{A_,AName_}] := Module[{ImgAuxData,ImgVectors,ImgRecoveredVectors},
{ImgAuxData,ImgVectors} = ImageToData[Img];
ImgRecoveredVectors = DecompressImage[A,CompressImage[A,ImgVectors]];
{DataToImage[{ImgAuxData,ImgRecoveredVectors}],ImgName <>"->" <> AName}
];

CompressedVersion[test,cm[[2]]]

Now we need to put together a comparison function. This is a UI thing which should require us to make a nice display of the original image, followed by full size versions of the two compressed versions, followed by a side by side version with a vote tallier.

MakeSlideShow[ImgData_,AData_,MagFactor_] := Module[{orig,compA,compB},
orig = ImgData[[1]];
compA = CompressedVersion[ImgData,AData[[1]]];
compB = CompressedVersion[ImgData,AData[[2]]];
TabView[{"Original"->Magnify[orig,MagFactor],"A"->Magnify[compA[[1]],MagFactor],"B"->Magnify[compB[[1]],MagFactor],"A vs B"->Magnify[GraphicsGrid[{{compA[[1]],compB[[1]]}}],MagFactor]},ImageSize->800]
];

ss = MakeSlideShow[test,cm,4];

ss

We’re now going to make the recorder. This will be a slider/button combination, with a slider to represent the current distribution of votes and a button to record the data.

VotingBar[ImgData_,AData_] := DynamicModule[{AVotes=0,BVotes=0,VoteRecorded = False},Magnify[Panel[Column[{Grid[{{"A Votes",Dynamic[AVotes], Slider[Dynamic[AVotes],{0,20,1}]}}],
Grid[{{"B Votes",Dynamic[BVotes],Slider[Dynamic[BVotes],{0,20,1}]}}],
Dynamic[If[VoteRecorded,"Vote Recorded",Button["Record Vote",
VoteRecorded=True;
{AVotes,BVotes,AData[[1,2]],AData[[2,2]],ImgData[[2]]} >>> NotebookDirectory[] <> "ComparisonFiles/comparisons.txt";
]]]}]],2]];

VotingBar[test,cm]

Finally, we can put everything together in a single function which will pull data and matrices, do the compression and so forth, and allow us to record votes:

GatherComparison[] := Module[{ImgData,AData,ss,vb},
ImgData = SourceImage;
AData = CompressionMatrices;
ss = MakeSlideShow[ImgData,AData,4];
vb = VotingBar[ImgData,AData];
Column[{ss,vb},Center]
];

GatherComparison[]

The Netflix Problem or Incomplete Ranking.

At this point, we’ve got 50 or 60 A/B comparisons between images. Of course, since there are a dozen images and 10 different sets of matrices, there are (10x9)/2 = 45 possible pairs of matrices and hence 45 x 12 = 540 possible comparisons that one could make. In other words, we don’t have all the data. 

On the other hand, to rank 10 matrices we need a minimum of 9 comparisons. To see this, suppose that there’s some group of matrices G and some other group H so that there are no comparisons between any matrix in group G and any matrix in group H. In this case, we certainly can’t rank G matrices versus H matrices. We just don’t have enough information.

So we have something between all the data and nowhere near enough data. 

This is where math really gets interesting. 

This is known as an incomplete ranking problem, or more colloquially as “the Netflix problem”. The idea is that we’d like to have a global ranking of all the movies on Netflix in order to recommend movies to new viewers, but no single person has even seen all the movies on Netflix, much less rated all the movies on Netflix. For any single person, given a pair of movies that they happen to have ranked, we can tell which one they liked more. 

We can also tell a little bit about how much more they liked the winning movie, but this signal is a bit harder to read. If you gave “Mortal Kombat” 3 stars, “The Notebook” 4 stars, and “The Avengers” 5 stars, did you really like “The Avengers” exactly 5/3 as much as you liked MK? Or did you like “The Notebook” only 4/3 as much? It seems the best we can say reliably is that you’d rank the three movies 

Avengers > Notebook > Kombat

A better gauge of the strength of this ranking is to compute the following:

(Avengers, Notebook) = # of people rating both who preferred Avengers 
			 - # of people preferring Notebook

and set 

(Notebook, Avengers) = -(Avengers, Notebook).

In a perfect world, there would be a well-defined “awesomeness score” α(M) assigned to every movie M so that for every pair of movies M, N we’d have

(M,N) = α(M) - α(N)

Statistically, this is more or less the assumption that everybody’s rating of a movie is distributed around a scaled version “awesomeness score” with some error function depending on how bad a judge of awesomeness you are so that the distance between awesomeness scores is (directly) proportional to the lopsidedness of the vote. Of course, a smart person would immediately ask a lot of good questions about the distribution of measurement errors, the likely differences between awesomeness scores compared to the likely size of errors and so forth, and maybe we could add some correction terms accordingly. But for right now, we’re not going to.

In fact, the existence of a well-defined α(M) function is honestly quite a lot to ask for. To foreshadow what we’re about to do, if such a function did exist, for any triple of movies P, Q, R, we’d have 

(P,Q) + (Q,R) + (R,P) = (α(P) - α(Q)) + (α(Q) - α(R)) + (α(R) - α(P)) = 0.

Let’s make this a little more formal. We recall that a graph consists of a vertex set V and an edge set E. In our case, the vertices will be matrices and the edges will be 

Definition. An edge flow on the graph (V,E) is a function f : E -> R so that f(v,w) = -f(w,v).

We can think of edge flows as “discrete vector fields”. And like all vector fields, we can write some of them as gradient fields.

Definition. An edge flow f on (V,E) is a gradient flow if there exists some α: V -> R called the potential function so that f(v,w) = α(w) - α(v) for all edges (v,w). The gradient of a function V -> R is an edge flow defined by 

(grad α) (v,w) = α(w) - α(v).

That is, we take “head - tail” as usual, and consider (v,w) to be the edge from v to w.

The edge flows form a vector space with the usual inner product

⟨f,g⟩ = (∑_((v,w) ϵ E)^( ))f(v,w) g(v,w)

We can define the divergence of an edge flow about like you’d expect:

Definition. The divergence of an edge flow f is the function (on vertices) defined by

(div f)(v) = (∑_(w so that (v,w) ϵ E)^( ))f(w,v)

Now recall that vector fields can be decomposed into gradient fields and divergence-free fields. In fact, this works in this context too!

Theorem. (Combinatorial Hodge Theorem). The vector space of edge flows can be orthogonally decomposed into 

(Edge Flows) = (image of grad) ⊕ (kernel of div).

We can now define our ranking algorithm, called HodgeRank:

1) Define a graph by letting the vertices V be the objects to be compared, and E to be the set of pairwise comparisons.

2) Define our edge flow f by f(v,w) = # of votes for w - # of votes for v.

3) Project f by least-squares onto the space of gradient fields, obtaining the field grad α. 

4) Recover the potential function α  and use this to rank the objects.

It’s now time for some Mathematica! First, we’ll pull data to construct vertices and edges from our total data set.

Vertices[CompLevel_] := Module[{MatrixNames,ShortNames},
MatrixNames = FileNames["*"<>ToString[CompLevel]<>".dat",NotebookDirectory[] <>"Matrices/"];
ShortNames = StringSplit[#,"/" | "."][[-2]] & /@ MatrixNames;
Sort[ShortNames]
];

Vertices[99]

EdgeData[CompLevel_] := Select[ToExpression /@ StringSplit[Import[NotebookDirectory[] <> "/ComparisonFiles/comparisons.txt"],EndOfLine],StringMatchQ[#[[3]],"*"<>ToString[CompLevel]<>"*"] &];

Edges[CompLevel_] := Sort[DeleteDuplicates[#[[1]]\[UndirectedEdge]#[[2]] & /@ (Sort /@ EdgeData[CompLevel][[;;,3;;4]])]];

Edges[99]

MakeGraph[CompLevel_] := Graph[Vertices[CompLevel],Edges[CompLevel],VertexLabels->((#->Placed[Panel[Text[Style[#,Large,Bold]],Background->LightGray],Center])& /@ Vertices[CompLevel])];

MakeGraph[99]

ConnectedComponents[MakeGraph[90]]

We now want to construct the edge function as a vector in the space of edge functions. To do this, we’re simply required to number the edges. The order in which they occur in the edge construction function will be fine. We can then work on constructing a basis for the gradient functions. This code gives you the edge flow in the ordering given by Edges[CompLevel].

EdgeFlow[CompLevel_] := Module[{edtotals,edges,MatchTotals},
edtotals = If[Order[#[[3]], #[[4]]] > 0,{#[[3]]\[UndirectedEdge]#[[4]],#[[2]] - #[[1]]} ,{#[[4]]\[UndirectedEdge]#[[3]],#[[1]] - #[[2]]}]& /@ EdgeData[CompLevel];
edges = Edges[CompLevel];
MatchTotals[edge_,edt_] :=  Transpose[Select[edt,#[[1]] == edge &]];
Transpose[{#[[1,1]],Total[#[[2]]]} & /@ (MatchTotals[#,edtotals] & /@ edges)][[2]]
];

Edges[99]

EdgeFlow[99]

We now code the gradient operation. For each edge, the idea is to take the difference of the corresponding gradient operations.

CombinatorialGradient[G_,F_] := Module[{verts,edges},
verts = VertexList[G];
edges = EdgeList[G];
F[[Position[verts,#[[2]]][[1,1]]]] - F[[Position[verts,#[[1]]][[1,1]]]] & /@ edges
];

Vertices[99]

Edges[99]

CombinatorialGradient[MakeGraph[99],{0,0,0,0,0,0,0,1,0,0}]

Ok, now we need to make a table of all the gradient edge flows. We first make a table of a basis for the potential functions.

PotentialBasis[G_] := Table[KroneckerDelta[i,j],{i,1,VertexCount[G]},{j,1,VertexCount[G]}];

GradientFlows[G_] := Transpose[CombinatorialGradient[G,#] & /@ PotentialBasis[G]];

Checking the dimensions of the gradient flows, and the matrix rank

Dimensions[GradientFlows[MakeGraph[99]]]

MatrixRank[GradientFlows[MakeGraph[99]]]

we see that the matrix problem is not full rank. 

In fact, it can never be full rank. This is because the combinatorial gradient of a (locally) constant function is zero, which means that the dimension of the null space of this matrix is the same as the number of connected components of the graph. This is another way of saying that we can’t rank groups which have no pairwise comparisons between the groups.

Mathematica is fine with solving an underdetermined least squares problem. But we’ll need a little care in interpreting the results-- we can only assemble rankings within each connected component, and remember that the data still may be highly inconsistent. We’ll have to measure the strength of the ranking once we’ve got it! 

To find the strength of the ranking, we should measure the size of the residual for each connected component separately. This is called the cyclicity ratio of the ranking, and it measures the quotient of the norm of the projection of the original ranking data to the combinatorial gradient subspace and the total norm of the data. Of course, we do this component-by-component so that a perfect ranking (for this component) has a ratio of 1.0 regardless of how much data we measured for other connected components.

We start with some helper code which restricts the data and the solution to a particular connected component and solves the problem there.

HodgeRankComponent[C_,G_,F_] := Module[{α,rankData,stencilα,cyclicityRatio,stencilF},
α = Transpose[LeastSquares[GradientFlows[G],Transpose[{F}]]][[1]];
stencilα = If[MemberQ[C,#[[1]]],#[[2]],0]& /@Transpose[{VertexList[G],α}];
stencilF = If[MemberQ[C,#[[1,1]]],#[[2]],0] & /@ Transpose[{EdgeList[G],F}];
cyclicityRatio = 1 - Norm[GradientFlows[G] . Transpose[{stencilα}] - stencilF]/Norm[stencilF];
Panel[Style[#[[1]] <> ": " <> ToString[N[#[[2]],2]],Large,FontFamily->"Helvetica"]] &/@Append[Sort[{#,α[[Position[VertexList[G],#][[1,1]]]]} & /@ C,#1[[2]] > #2[[2]] &],{"Cyclicity Ratio",cyclicityRatio}]
];

Then we just need to assemble the results over all components:

HodgeRank[G_,F_] := Grid[{Column[HodgeRankComponent[#,G,F]] & /@ ConnectedComponents[G]}];

Aaand we can now view the graphs and the awards for all the compression levels!

MakeGraph[50]

HodgeRank[MakeGraph[50],EdgeFlow[50]]

MakeGraph[90]

HodgeRank[MakeGraph[90],EdgeFlow[90]]

MakeGraph[99]

HodgeRank[MakeGraph[99],EdgeFlow[99]]