# How to simplify this NetGraph a bit?

I have a NetGraph that takes list of sublists, and outputs a real value that is higher when there are more near duplicate sublists.

For example, run this code with the net defined below:

net @ {{.1,.2,.3}, {.6,.3,.5}, {.4,.9,.8}}   (* 0.848  no near dupes -> low  *)
net @ {{.5,.5,.5}, {.45,.5,.5}, {1,1,1}}     (* 0.997  most near dupes -> higher *)
net @ {{1,1,1}, {1,1,1}, {1,2,3}}            (* 1.0    exact dupe -> highest  *)


However, the way the NetGraph is written it looks ugly, and I could use some help cleaning it up a little bit:

1. There's definitely duplication of code that might/should be removable?
2. It only works for lists of exactly 3 sublists. I'd like it to extend it to any number (e.g. call Subsets[#, {2}] on the input to get the pairs and check them all for near duplicates)
3. It is forcing the "bad" inputs to very near 1.0. If I want to use this as a loss, is there a better activation to do here?

Here is the network:

net = NetInitialize @ NetGraph[
<|
"touple1" -> PartLayer[1], "touple2" -> PartLayer[2], "touple3" -> PartLayer[3],
"sum1" -> SummationLayer["Input"->{3}],
"sum2" -> SummationLayer["Input"->{3}],
"sum3" -> SummationLayer["Input"->{3}],
"tan" -> ElementwiseLayer[Tanh[1/#]&]
|>,
{
{"touple1", "touple2"} -> "thread1" -> "sum1",
{"touple1", "touple3"} -> "thread2" -> "sum2",
{"touple2", "touple3"} -> "thread3" -> "sum3",
{"sum1", "sum2", "sum3"} -> "min" -> "tan"
}]


I am not really sure about how you want to use this loss so I am providing a simple method to check if a list as any duplicate plus some ideas for a more complex score system.

A very important constraint is that the framework does not support two varying dimensions at once, so

• [n1,3]+[n1,3] -> [n1|n2, 3] OK
• [n1,3]+[n1,3] -> [n1, n2, 3] NOT OK

As test data I am using what you have in the question

dataset = {
{{.1, .2, .3}, {.6, .3, .5}, {.4, .9, .8}},
{{.5, .5, .5}, {.45, .5, .5}, {1, 1, 1}},
{{1, 1, 1}, {1, 1, 1}, {1, 2, 2}},
{{1, 1, 1}, {1, 1, 1}, {1, 1, 1}, {1, 2, 2}, {1, 2, 2}},
{{1, 1, 1}, {1, 1, 1}, {1, 2, 2}, {1, 2, 2}, {1, 2, 2}, {1, 2, 2}},
{1, 1, 1} # & /@ Range[1., 1.05, 1/100]
};


# Simple duplicate check

The idea here is just to check if the list contains a duplicate and otherwise return the smallest pairwise distance.

Given the matrix of the absolute distances

MatrixForm@Outer[Total[Abs[#2 - #1]] &, #, #, 1] & /@ dataset


we want to extract the minimal value while getting rid of the diagonal, as that will be constantly 0.

This first net is used to extract the pairwise distance (I am using comments to track the tensor dimensions):

(* ([dims], [dims]) => [] *)
elementDiff = NetGraph[
{{NetPort["Input"], NetPort["ConstantElement"]} -> 1 -> 2}
];


Now we need a structure to mimic what Outer is doing, keeping in mind that our constraint forces us to contract the tensor before the second variable dimension appears.

The idea will be to do something like

reduce2[Table[reduce1[Table[elementDiff[a,b], {b, list}]], {a, list}]]


where reduce1 is a function that finds the off diagonal minimum and reduce2 can be simply Min.

We can use NetFoldOperator to mimic the mapping operation and we are going to leverage its ability to keep an input constant via its third argument. The rest of the graph is for the part extraction.

(* ([n, dims], [dims]) => [] *)
rowDiff = NetGraph[
{
NetFoldOperator[elementDiff, {}, {"ConstantElement"}], (* ([n, dims], [dims]) => [n] *)
OrderingLayer[2], (* [n] => [2] *)
PartLayer[2], (* [2] => [] *)
ExtractLayer[] (* [n] => [] *)
},
{
NetPort["ConstantRow"] -> NetPort[1, "Input"],
NetPort["Input"] -> NetPort[1, "ConstantElement"],
1 -> 2 -> 3,
{1, 3} -> 4
}
];


Now that we have the minimum of a row, we have to iterate over each row and take the global minimum as the final result

(* [n, dims] => [] *)
totalDiff = NetGraph[
{
NetFoldOperator[rowDiff, {}, {"ConstantRow"}], (* ([n, dims], [n, dims]) => [n] *)
AggregationLayer[Min, 1] (* [n] => [] *)
},
{
NetPort["Input"] -> {NetPort[1, "Input"], NetPort[1, "ConstantRow"]},
1 -> 2
},
"Input" -> {Automatic, Automatic}
];


Given that up to this point there is no dimensional constraint, I use "Input" -> {Automatic, Automatic} to specify that the input is a tensor of rank 2, otherwise evaluating on a batch will lead to a single number.

This is the result on the test data

totalDiff[dataset]

(* {0.8, 0.05, 0., 0., 0., 0.03} *)


This method is pretty simple but uses only a small part of the data and does not distinguish between one and many duplicated but it might be enough for some applications.

# Similairy score

To overcome the disadvantages of the previous method, another approach is to use a continuous score that "counts" the number of duplicates. I gave it some thought and I did not much like any practical implementation so I am just going to share some ideas here.

This is one possible function for the job

Plot[1 - Tanh[x], {x, 0, 5}, PlotRange -> All]


that gives the following score matrices for out test dataset

Style[MatrixForm@Outer[1. - Tanh[Total[Abs[#2 - #1]]] &, #, #, 1],
PrintPrecision -> 3] & /@ dataset


One possibility is to define a "row score" which is the sum of all the pairwise scores (subtracting 1 to remove the effect of the diagonal) and then sum over the rows.

The elementDiff net needs just one more layer to compute the score

(* ([dims], [dims]) => [] *)
elementDiff = NetGraph[
{ThreadingLayer[Abs@*Subtract], SummationLayer[], ElementwiseLayer[1 - Tanh[#] &]},
{{NetPort["Input"], NetPort["ConstantElement"]} -> 1 -> 2 -> 3}
];


and in rowDiff now we are performing the row sum, the -1 shift plus a normalization to avoid counting the same pairs more than once

(* ([n, dims], [dims]) => [] *)
rowDiff = NetGraph[
{
NetFoldOperator[elementDiff, {}, {"ConstantElement"}], (* ([n, dims], [dims]) => [n] *)
SummationLayer[], (* [n] => [] *)
ElementwiseLayer[(# - 1)/# &] (* [] => [] *)
},
{
NetPort["ConstantRow"] -> NetPort[1, "Input"],
NetPort["Input"] -> NetPort[1, "ConstantElement"],
1 -> 2 -> 3
}
];


The only change in totalDiff is Min -> Total.

The final result is

totalDiff[dataset]

(* {0.877242, 1.17319, 1.08478, 3.07462, 4.08478, 4.93808}


But wait! The second value is higher than the third one! And the last one is very high as well. Not good... This is because the second list has two elements very close and the third one has one equality and one very far, which throws off the score. One solution is to use Tan[x / a] with a tuning the scale of a "significant" difference. Using a = 1/100 gives

totalDiff[dataset]

{0., 0.000181658, 1., 3., 4., 0.0491138}


which is more in line with our desires. As I said at the beginning, I am not too happy with this result. I put it here anyways to throw some ideas around.