Loopy Belief Propagation

I look for an efficient way to implement a Belief Propagation in Pairwise Markov Random Field.

Each node is a binary random variable, and the unary potential function is

nodePotential[v_] := Piecewise[{{a, v == 1}, {1-a, v == -1}}]


The pairwise potential function is

pairwisePotential[p_] := {{p, 1 - p}, {1 - p, p}}


I have a data structure which contains the unary potential of each node:

nodePot=Association@Map[# -> {0.3, 0.7} &, VertexList@g1]


And data structure which contains the pairwise potential is a matrix

edgeSimilarity=AdjacencyMatrix[g1]*0.6;


Note that I deal with different unary/pairwise potential, but for simplifying the question, I am using here homogeneous.

With the following function, I calculate the LBP

LBP[data_, index_] :=
Module[{totalPo, nonZeroPosition, nonZeroValues, nzp, nzv, newP, edP, spNZV},
totalPo = Total@data["NonzeroValues"];
nonZeroPosition = data["NonzeroPositions"];
nonZeroValues = data["NonzeroValues"];
edP = edgeSimilarity[[index]]["NonzeroValues"];
edP = DeleteCases[edP, 0.0];
edP = pairwisePotential[#] & /@ edP;
edP = (Exp[totalPo - #] & /@ nonZeroValues)*edP;
nzv = (nodePot[index].#) & /@ Flatten[edP, 1];
{newP, nzv}
]


I work in log domain to prevent the numerical issues in dense graph

newMessageMatrix[data_] := Module[{res, positions, values},
res = Transpose@data;
positions = Flatten[Join [{{{{1, 1}}}}, Transpose[{res[], res[]}]], 2];
values = Log[Flatten@Join[{1.0000000000001}, res[]]];
Chop@With[{spopt = SystemOptions["SparseArrayOptions"]},
InternalWithLocalSettings[
SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> List}],
SparseArray[positions -> values, Dimensions[s], 0],
SetSystemOptions[spopt]]]
]


valuesAndPositions = LBP[sT[[#]], #] & /@VertexList[g1];
`