Find binary vector within fixed distance to reference vector that maximizes the number of distances to a set of vector that are below a threshold

Question

Input: A binary reference vector $r$, a multi-set of binary vectors $S$, and a distance function d between binary vectors of equal length. Assume that $r$ and all vectors in $S$ have the same length.

Objective: We want to find a binary vector $r'$ that maximizes the number of vectors $s \in S$ for which $d(r', s) \leq k$ for some fixed $k$.

Constraint: We require that the vector we find is within a certain distance $j$ of the reference vector, so $d(r, r') \leq j$.

Formally, we want $$arg \max\limits_{i : d(i,r) \leq j} \sum\limits_{s \in S} [[d(i,s) \leq k]]$$

Where $[[d(i,s) \leq k]]$ is 1 if $d(i,s) \leq k$, else 0.

Details: We specifically want to solve this problem when the distance function $d$ is the Hamming Distance, but it would be nice to be able to substitute any distance function, or at least any distance function built into Mathematica.

Attempts: The following code (adapted from a post here) computes the unconstrained version of the problem that doesn't enforce a maximum distance to a reference vector.

numApprovals[x_?(MatrixQ[#, NumericQ] &), 
   y_?(VectorQ[#, NumericQ] &), k_] := 
  Length[Select[HammingDistance[#, y] & /@ x, # <= k &]];

length = 3;

maximizeApprovals[x_, k_] := 
 Maximize[{numApprovals[x, Array[y, length], k], 
   Thread[0 <= Array[y, length] <= 1]}, 
  Array[y, length] \[Element] Integers]

answerAssoc = 
  maximizeApprovals[{{1, 1, 1}, {0, 1, 0}, {1, 1, 1}}, 
   Ceiling[length/2]];

answer = Values[answerAssoc[[2]]]

However, when I try to adding the additional constraint to the maximizeApprovals function, it doesn't work. The following code evaluates symbolically.

maximizeApprovals[x_, k_, ref_, j_] := 
 Maximize[{numApprovals[x, Array[y, length], k], 
   Thread[0 <= Array[y, length] <= 1], 
   HammingDistance[ref, y] <= j}, 
  Array[y, length] \[Element] Integers]

answerAssoc = 
 maximizeApprovals[{{1, 1, 1}, {0, 1, 0}, {1, 1, 1}}, 
  Ceiling[length/2], {0, 1, 0}, 1]

Adding pattern testing to the inputs doesn't seem to solve the problem.

However, if I have a fixed length, say 3, I can hard-code the constraint corresponding to the HammingDistance by taking the sum of the absolute difference of the corresponding elements and it works fine.

maximizeApprovals[x_?(MatrixQ[#, NumericQ] &), k_?(IntegerQ[#] &), 
  ref_?(VectorQ[#, NumericQ] &), j_?(IntegerQ[#] &)] := 
 Maximize[{numApprovals[x, Array[y, length], k], 
   Thread[0 <= Array[y, length] <= 1], 
   Abs[y[1] - ref[[1]]] + Abs[y[2] - ref[[2]]] + 
     Abs[y[3] - ref[[3]]] <= j}, {Array[y, length] \[Element] 
    Integers}]

But if I use the built-in HammingDistance function, or try to use BitXor, to get it to work for any length, neither works.

maximizeApprovals[x_?(MatrixQ[#, NumericQ] &), k_?(IntegerQ[#] &), 
  ref_?(VectorQ[#, NumericQ] &), j_?(IntegerQ[#] &)] := 
 Maximize[{numApprovals[x, Array[y, length], k], 
   Total[BitXor[ref, y]] <= j, 
   Thread[
    0 <= Array[y, length] <= 1]}, {Array[y, length] \[Element] 
    Integers}]

maximizeApprovals[x_?(MatrixQ[#, NumericQ] &), k_?(IntegerQ[#] &), 
  ref_?(VectorQ[#, NumericQ] &), j_?(IntegerQ[#] &)] := 
 Maximize[{numApprovals[x, Array[y, length], k], 
   HammingDistance[ref, y] <= j, 
   Thread[
    0 <= Array[y, length] <= 1]}, {Array[y, length] \[Element] 
    Integers}]

Answer 1

The following is an adaptation of your code. I just tried to get it to work, still using Maximize, ignoring efficiency. Please Quit[] before trying this:

(* auxiliaries
   did not try distance functions other than Hamming *)
binVec={(0|1)..};
distanceFunction[a:binVec][b:binVec]:=HammingDistance[a,b];

(* now using <= k *)
numApprovals[x:{binVec..},ys:binVec,k_]:=Length[
   Select[Map[distanceFunction[ys],x],(#<=k)&]];

(* version without constraint, but with optional penalty *)
maximizeApprovals[x:{binVec..},k_,penalty_:(0&)]:=Module[{y},
   With[{ys=Array[y,Length[First[x]]]},
     Maximize[{numApprovals[x,ys,k]+penalty[ys],
        Thread[0<=ys<=1]},ys\[Element]Integers]//{First[#],ys/.Last[#]}&]];

(* version with constraint, via suitably large penalty *)
maximizeApprovals[x_,k_,ref_,j_]:= With[{p=-Length[x]-1},
     maximizeApprovals[x,k,If[distanceFunction[ref][#]<=j,0,p]&]];

Comment. I switched to using a penalty since a constraint such as distanceFunction[ref][ys]<=j in Maximize seemed not to work. It makes sense that there are limits to what constraints are allowed, even if in this particular case Maximize will end up brute-forcing anyway I think.

Examples. One without, one with constraint:

maximizeApprovals[{{1,1,1},{0,1,0},{1,0,0}},1]
(* {3,{1,1,0}} *)

maximizeApprovals[{{1,1,1},{0,1,0},{1,0,0}},1,{0,0,0},1]
(* {2,{0,0,0}} *)

Warning. Did not test beyond these examples.