Generating vectors with small inner products in a large vector space

Question

I want to generate a large number $k$ of vectors of norm 1 in a $d$ dimensional vector space such that $k>d$. I want these vectors to have inner products as small as possible.

A crude way is to generate random vectors using RandomPoint. Basically I am selecting 300 random vectors from a 100 dimensional sphere.

v = RandomPoint[Sphere[100],300] /. {x_?NumericQ :> x Exp[I RandomReal[{0, 2 Pi}]]}

A matrix is constructed by taking the inner products of these random vectors.

M = Outer[Abs@*Dot, Conjugate[v], v, 1]

Since the norm of each vector is 1, the diagonal elements are 1. Also since the sphere's dimension is 100, the rank of this matrix is 100. In addition to the diagonal components, there are various non zero diagonal components, which are basically these non zero inner products.

Equivalently, it is helpful to visualize this using the list density plots as indicated in this answer.

ListDensityPlot[M, PlotLegends -> Automatic, ScalingFunctions -> "Log"]

What I am aiming for in the above figure is mostly blue off diagonal elements, while still maintaining the $x=y$ white line. Another way to visualize this by looking at the histogram at the $y =50$ slicing,

What I want to get in this histogram is that most of the elements are close to zero, while still maintaining the element at 1.

There are two ways to do so:

1. Can I constrain the vector generation from the beginning itself in such a way that the inner products between the vectors are close to zero? Basically is there a better way of generating such vectors than randomly generating them?

2. Using techniques such as row reduction, is it possible to reduce the norm of most of the off diagonal components (preferably very close to zero) of the matrix M, while strictly maintaining the diagonal entries to be 1?

   Note that I am not taking about diagonalizing the matrix, for if one attempts to diagonalize M, we will have only 100 entries which are 1, and not all 300.

Answer 1

OK, stealing from my other answer here

There's no need to immediately generate the complex numbers, so hold off.

push[p1_, p2_] := If[p1 != p2, p1 + α (p1 - p2)/((p1 - p2).(p1 - p2))^β, p1];

spread[pts_] := Map[Normalize, (Outer[push[#1, #2] &, pts, pts, 1] // Transpose // Total)];

maxDot[pts_] := Map[Dot[#[[1]], #[[2]]] &, Permutations[pts, {2}]] // Max;

Do a 100D problem with 200 points. Set $\alpha$ and $\beta$ as below (they control behavior of the algorithm).

dim = 100;
n = 200;
pts = RandomPoint[Sphere[dim], n];
α = 1;
β = 4;

Iterate 300 times

res = Nest[spread[#] &, pts, 300];

ListDensityPlot it

mat = Outer[Dot, res, res, 1];

ListDensityPlot[mat, PlotLegends -> Automatic, InterpolationOrder -> 0, PlotRange -> All]

Now you can convert the points to complex numbers. Note, I am not using a log scale for the color legend.

complexRes = res/. {x_?NumericQ :> x Exp[I RandomReal[{0, 2 Pi}]]};

cmat = Outer[Abs@*Dot, complexRes, Conjugate@complexRes, 1];

ListDensityPlot[cmat, PlotLegends -> Automatic, InterpolationOrder -> 0, PlotRange -> All];