# Find the shortest possible unique keys

1. Problem statement

Given a certain rectangular matrix I want to scan its rows from left right to find equally sized sequences. These sequences should be as short as possible and unique, so that they can be used as Keys to associate the remaining row members. A FirstShortestUncommonSequence, so to speak.

2. Test data

list =
{{2, 4, 1, 7, 1, 4, 1},
{1, 2, 3, 7, 2, 4, 0},
{1, 4, 1, 7, 3, 5, 1},
{2, 4, 1, 7, 4, 5, 0},
{1, 1, 1, 7, 5, 5, 3}}


3. Example code

The following code is terrible (it doesn't even have an exit clause), and I only show it to give some examples.

CreateKeys[list_?MatrixQ] :=
Module[{p},
p =
First @ FirstPosition[True]@
Table[
Length @ DeleteDuplicates[#] == Length[#] & [list[[All, ;; i]]],
{i, Length @ First @ list}];

If[NumberQ[p],
AssociationThread[list[[All, ;; p]] -> list[[All, p + 1 ;;]] /. {a_} :> a],
p]]


4. Examples of expected result

CreateKeys @ list


should give

<|{2, 4, 1, 7, 1} -> {4, 1},
{1, 2, 3, 7, 2} -> {4, 0},
{1, 4, 1, 7, 3} -> {5, 1},
{2, 4, 1, 7, 4} -> {5, 0},
{1, 1, 1, 7, 5} -> {5, 3}|>


o

 CreateKeys[{{1, 1, 4}, {2, 1, 5}}]


<|1 -> {1, 4}, 2 -> {1, 5}|>

o

CreateKeys[{{1, 1, "a", "b"}, {1, 5, "a", "d"}}]


<|{1, 1} -> {"a", "b"}, {1, 5} -> {"a", "d"}|>

and, if no unique keys can be found,

CreateKeys[{{1, 1}, {1, 1}}]


"NotFound"

5. Question

How can this problem be solved in a functional and efficient way?

Association@(Rule @@@ (TakeDrop[#,
True]] & /@ list))

(* <|{2, 4, 1, 7, 1} -> {4, 1},
{1, 2, 3, 7, 2} -> {4, 0},
{1, 4, 1, 7, 3} -> {5, 1},
{2, 4, 1, 7, 4} -> {5, 0},
{1, 1, 1, 7, 5} -> {5, 3}|> *)


Maybe more efficient for long sub-lists of list:

n = 1;
While[Not@DuplicateFreeQ[list[[All, 1 ;; n++]]]];
Association@(Rule @@@ (TakeDrop[#, n - 1] & /@ list))

• Thank you, this gives all expected results and is astonishingly short
– eldo
Oct 4, 2023 at 11:40
ClearAll[sKeys]

sKeys = Replace[#,
{x__, y___} /; DuplicateFreeQ[#[[All, ;; Length @ {x}]]] :> {x} -> {y}, 1] &;


Examples:

sKeys @ list

{{2, 4, 1, 7, 1} -> {4, 1},
{1, 2, 3, 7, 2} -> {4, 0},
{1, 4, 1, 7, 3} -> {5, 1},
{2, 4, 1, 7, 4} -> {5, 0},
{1, 1, 1, 7, 5} -> {5, 3}}

sKeys @ {{1, 1, 4}, {2, 1, 5}}

 {{1} -> {1, 4}, {2} -> {1, 5}}

sKeys @ {{1, 1, "a", "b"}, {1, 5, "a", "d"}}

 {{1, 1} -> {"a", "b"}, {1, 5} -> {"a", "d"}}


If the input list lst is not duplicate-free, sKeys returns lst:

sKeys @ {{1, 1}, {1, 1}, {1, 2}}

 {{1, 1}, {1, 1}, {1, 2}}


If {} is the desired ouput for such inputs, wrap sKeys with ReplaceAll[# -> {}]:

sKeys2 = ReplaceAll[# -> {}] @ sKeys @ # &;

sKeys2 @ {{1, 1}, {1, 1}, {1, 2}}

{}

ClearAll[keyLength, shortestDistinctPrefixKeys]

keyLength = Module[{k = 0}, Until[DuplicateFreeQ[#[[All, ++k]]]]; k] &;

shortestDistinctPrefixKeys[lst_?DuplicateFreeQ] :=
Map[Apply[Rule] @ TakeDrop[#, keyLength @ lst] &] @ lst

shortestDistinctPrefixKeys[_] = {};


Examples:

shortestDistinctPrefixKeys @ list

 {{2, 4, 1, 7, 1} -> {4, 1},
{1, 2, 3, 7, 2} -> {4, 0},
{1, 4, 1, 7, 3} -> {5, 1},
{2, 4, 1, 7, 4} -> {5, 0},
{1, 1, 1, 7, 5} -> {5, 3}}

shortestDistinctPrefixKeys @ {{1, 1, 4}, {2, 1, 5}}

 {{1} -> {1, 4}, {2} -> {1, 5}}

shortestDistinctPrefixKeys @ {{1, 1, "a", "b"}, {1, 5, "a", "d"}}

 {{1, 1} -> {"a", "b"}, {1, 5} -> {"a", "d"}}

shortestDistinctPrefixKeys @ {{1, 1}, {1, 1}, {1, 2}}

{}

createKeys[list_?MatrixQ] := Module[{noDFQ = False (* !DuplicateFreeQ *)},
AssociationThread[# -> list[[All, (1 + Length@First@#) ;; ]]]] &@
FoldWhile[Flatten /@ Thread[{##}] &, (noDFQ = ! DuplicateFreeQ@#; noDFQ)&]
[Map[List, Transpose@list, {2}]]]

testmat = {
{{2, 4, 1, 7, 1, 4, 1}, {1, 2, 3, 7, 2, 4, 0}, {1, 4, 1, 7, 3, 5, 1}
, {2, 4, 1, 7, 4, 5, 0}, {1, 1, 1, 7, 5, 5, 3}}
, {{1, 1, 4}, {2, 1, 5}}
, {{1, 1}, {1, 1}}}

createKeys /@ testmat

(*{<|{2, 4, 1, 7, 1} -> {4, 1}, {1, 2, 3, 7, 2} -> {4, 0}, {1, 4, 1, 7, 3} -> {5, 1}
, {2, 4, 1, 7, 4} -> {5, 0}, {1, 1, 1, 7, 5} -> {5, 3}|>
, <|{1} -> {1, 4}, {2} -> {1, 5}|>
, <||>}*)