Code for Alda Scale Mutual Information Analysis in Asymmetrical Reliability of the Alda Score favours a Dichotomous Representation of Lithium Response

Abraham Nunes (nunes@dal.ca), Thomas Trappenberg, and Martin Alda
Dalhousie University, Halifax, Nova Scotia, Canada

Analysis of Reliability of the Total Alda Score

Table 1 Summarizing the Average Total Scores Across the Sites

wd = "path/to/directory/here/";
SetDirectory[wd];

irrds = Import["S1_File.csv", "Dataset", HeaderLines->1];

summary =Dataset[JoinAcross[Dataset[KeyValueMap[<|"Site"->#,"N Raters"->#2|>&,
	irrds[Counts, "Site"]]], 
Dataset[KeyValueMap[<|
"Site"->#1,"Case 1"->#2[[1]], "Case 2"->#2[[2]],
"Case 3"->#2[[3]],"Case 4"->#2[[4]],"Case 5"->#2[[5]],
"Case 6"->#2[[6]],"Case 7"->#2[[7]],"Case 8"->#2[[8]],
"Case 9"->#2[[9]],"Case 10"->#2[[10]],"Case 11"->#2[[11]],
"Case 12"->#2[[12]]|>&,irrds[GroupBy["site"],
	Round[N@Mean[#],0.1]&, Table["Case "<>ToString[i], {i, 12}]]]], 
"Site"]];

summary = TextGrid[Flatten[
	Catenate[{{{Normal@Keys[(summary^\[Transpose])]}},{List@@@Normal@summary}}],1], 
Frame->All]

Analysis of the Reliability under Noise

X = Transpose[List@@@Normal@irrds[2;;, 4;;]];
y =  Flatten[List@@@Normal@irrds[{1}, 4;;]];
X = X[[Ordering[y]]];
y = y[[Ordering[y]]];

RatingHistogram := Function[{X, y}, 
	Grid[
		ArrayReshape[{
			Table[Histogram[
					X[[i]],
					PlotLabel-> Style["Gold Standard: "<>ToString[y[[i]]], Black, Bold, 13],
					ChartStyle->ColorData[63][({{\[Piecewise], ({{1, y[[i]]≥7}, {2, True}})}})], 
					PlotRange->{{-1, 11}, Automatic}, 
					Frame->True, FrameStyle->Directive[Black, 12],
					FrameLabel->{"Observed Rating", "Count"},
					PlotTheme->"Scientific"], 				
			{i, Length@y}]}, {3, 4}]]]
totalscorehistfig = RatingHistogram[X, y]
(*Export["total-score-hist-fig.pdf", totalscorehistfig, "AllowRasterization"->True];*)

Estimation of Conditional Distributions

Let  (Subscript[n, i]^((k)))∈(SubPlus[ℕ]) denote the number of raters who assigned Alda score i∈𝒜, with 𝒜={0, 1, ..., 10}, to an individual whose gold standard score is k∈𝒜. The vector of rating counts given gold standard score k is (n^((k)))=(Subscript[((Subscript[n, i]^((k)))), i∈𝒜]). The probability of (n^((k)))is multinomial with parameter vector (θ^((k)))=(Subscript[((Subscript[θ, i]^((k)))), i∈𝒜]), which is itself Dirichlet distributed (θ^((k)))\[Distributed]Dir(θ|α), where α are pseudocounts. The posterior of of (θ^((k))) given (n^((k))) and α is Dirichlet with parameters α'=(Subscript[{(Subscript[α, i])+(Subscript[n, i]^((k)))-1}, i=0]^10). The MAP estimate of (θ^((k))) given α and (n^((k))) can then easily be shown to equal

	(Subscript[(OverHat[θ]), α])((n^((k))))=(Subscript[{(((Subscript[α, i])+(Subscript[n, i]^((k)))-1)/((∑_(j=0)^10)((Subscript[α, j])+(Subscript[n, j]^((k)))-1)))}, i=0]^10).

In the following analyses, we take (Subscript[(OverHat[θ]), α])((n^((k)))) to be the conditional distribution over scores 𝒜 for any given rater when the gold standard score is k.

The thresholded Alda scores are defined as 𝒯={(Subscript[𝟙, i≥7]):(Subscript[∀, i∈𝒜])}, where (Subscript[𝟙, x]) is an indicator function that evaluates to 1 if x is true, and 0 otherwise.
	
Letting (Subscript[c, i]^((k)))=(Subscript[𝟙, (Subscript[n, i]^((k)))≥7]),  (Subscript[c, i]^((k)))\[Distributed]Multinomial((ϕ^((k)))), and (ϕ^((k)))\[Distributed]Dir(ϕ|ξ), then we can estimate conditional distributions (Subscript[(OverHat[ϕ]), ξ])((c^((k)))) analogously to our process in the full score as follows: 

	(Subscript[(OverHat[ϕ]), ξ])((c^((k))))=(Subscript[{(((Subscript[ξ, i])+(Subscript[c, i]^((k)))-1)/((∑_(j=0)^1)((Subscript[ξ, j])+(Subscript[c, j]^((k)))-1)))}, i=0]^1).
	
Let (SubStar[x]) denote a “true” (gold standard) Alda score in 𝒜 and (Subscript[x, o]) be a single observed rating on that same domain. Given uniform priors on the true classes, (Subscript[∀, k∈𝒜 ])p((SubStar[x])=k)=(1/11), the joint distribution over true and observed ((Subscript[x, o])) full-scale ratings is 

	p((Subscript[x, o]),(SubStar[x]))=p((Subscript[x, o])|(SubStar[x]))p((SubStar[x]))=(Subscript[{p((Subscript[x, o])=i|(SubStar[x])=k)p((SubStar[x])=k)}, i=0,1,...,10]^(k=0,1,...,10))=(Subscript[{(1/11)(Subscript[(OverHat[θ]), α])((n^((k))))}, k=0,1,...,10]).

Similarly for the binarized classes, we have a prior of  p((SubStar[y]))={(7/11), (4/11)}, and the joint distribution is thus 

	p((Subscript[y, o]),(SubStar[y]))=p((Subscript[y, o])|(SubStar[y]))p((SubStar[y]))=(Subscript[{p((Subscript[y, o])=i|(SubStar[y])=k)p((SubStar[y])=k)}, i=0,1]^(k=0,1))={(7/11)(Subscript[(OverHat[ϕ]), ξ])((c^((0)))), (4/11)(Subscript[(OverHat[ϕ]), ξ])((c^((1))))}.

DirMulEstimate[α_]:= Function[Q, 
	Module[{λ},
	λ = Flatten@Table[
		α[[i]] + ({{\[Piecewise], ({{0, Flatten[Position[Tally[Q][[All, 1]], i]]=={}}, {Tally[Q][[Flatten[Position[Tally[Q][[All, 1]], i]], 2]], True}})}}) - 1, 
		{i,Length@α}];
	λ/Total[λ]
]]

Compute the conditional distribution:

Q[α_:2] := (({
	DirMulEstimate[Table[α, 11]][Table[Min[{Max[{X[[1]][[i]]-1, 0}], 10}], {i, Length@X[[1]]}]],
	DirMulEstimate[Table[α, 11]][X[[1]]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 1, 3}]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 2, 3}]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 2, 5}]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 4, 5}]],
	DirMulEstimate[Table[α, 11]][X[[6]]],
	DirMulEstimate[Table[α, 11]][X[[7]]],
	DirMulEstimate[Table[α, 11]][X[[8]]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 9, 12}]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]+1], {k, 9, 12}]]
})^\[Transpose])

Thresholded Alda scores and joint distribution function:

ThresholdAlda[X_]:=Table[({{\[Piecewise], ({{0, x<7}, {1, True}})}}), {x, X}];
J[α_:2]:= {
(7/11)DirMulEstimate[Table[α, 2]][ThresholdAlda@Flatten@X[[;;6]]+1],
(4/11)DirMulEstimate[Table[α, 2]][ThresholdAlda@Flatten@X[[7;;]]+1]
}

Joint Distribution over True and Observed Scores

jointdistribaldascorefig = ArrayPlot[(Q[2]Table[(1/11), {i, 11}, {i, 11}]), 
PlotLabel->Style["Joint Distribution over True and Observed Alda Score", Black, 13],
PlotTheme->"Scientific",
ColorFunction->"ThermometerColors",
PlotLegends->Automatic, 
Frame->True,FrameStyle->Directive[Black, 13], 
FrameLabel->{"Observed Alda Score", "True Alda Score"},
 FrameTicks->{(({Range[11], Range[0, 10]})^\[Transpose]), (({Range[11], Range[0, 10]})^\[Transpose])}, ImageSize->350]
 
(*Export["jointdistributionaldascore.png", jointdistribaldascorefig, ImageResolution->500, "AllowRasterization"->True];*)

We can compute the mutual information between the observed and gold standard Alda scores (continuous and thresholded) as follows:

	(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]=(∑_(i∈𝒜))(∑_(j∈𝒜))p((Subscript[x, o])=i,(SubStar[x])=j)Log[((p((Subscript[x, o])=i,(SubStar[x])=j))/(p((Subscript[x, o])=i)p((SubStar[x])=j)))],

and

	(Subscript[𝕀, ξ])[(Subscript[y, o])||(SubStar[y])]=(∑_(i∈𝒯))(∑_(j∈𝒯))p((Subscript[y, o])=i,(SubStar[y])=j)Log[((p((Subscript[y, o])=i,(SubStar[y])=j))/(p((Subscript[y, o])=i)p((SubStar[y])=j)))],

respectively. We maintain the hyperparameters α and ξ in the notation since they control the level of uncertainty in the conditional distributions. Higher values of α and ξ yield conditional distributions (Subscript[(OverHat[θ]), α])((n^((k)))) and (Subscript[(OverHat[ϕ]), ξ])((c^((k)))) with higher uncertainty (i.e they are noisier).

Pxy[α_]:= (Q[α]Table[(1/11), {i, 11}, {i, 11}]);
Px[α_]:= (Total@Pxy[α]);
Py[α_]:= Total[((Pxy[α])^\[Transpose])];
Jxy[α_]:= J[α];
Jx[α_]:= (Total@Jxy[α]);
Jy[α_]:= Total[((Jxy[α])^\[Transpose])];

Letting ξ = (11/2)α in order to provide some equivalence between the priors, we can plot (Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])] and (Subscript[𝕀, ξ])[(Subscript[y, o])||(SubStar[y])] across increasing levels of uncertainty.

AldaMI[α_]:=N@Total[Total[Pxy[α] Log[((Pxy[α])/(Px[α]⊗Py[α]))]]]
DiscreteAldaMI[α_]:=N@Total[Total[Jxy[α] Log[((Jxy[α])/(Jx[α]⊗Jy[α]))]]]

mitotalaldafig = Plot[
	{AldaMI[α], DiscreteAldaMI[α]}, {α, 2, 10}, 
	PlotStyle->63, Frame->True, FrameStyle->Directive[Black,15], 
	FrameLabel->{"α", "Mutual Information"}, 
	PlotTheme->"Scientific", 
	PlotLegends->Placed[{
		Style["Raw", Black, 16],
		Style["Dichotomized", Black, 16]}, 
		{0.75, 0.75}], 
	ImageSize->350]
(*Export["~/Desktop/mutualinformationaldascores.png", 
		mitotalaldafig, 
		ImageResolution->500, 
		"AllowRasterization"->True];*)

We therefore note a whole set of conditions after approximately α=3.5 in which discretization is more informative than the continuous distribution.

But why is this the case? The plots below show that asymmetry may be the culprit.

partA = GraphicsGrid[{{DiscretePlot3D[Pxy[0.0001][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 0)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[0.0001], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)0.0001][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 0)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[0.0001], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

partB = GraphicsGrid[{{DiscretePlot3D[Pxy[10][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 10)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[10], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)10][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 10)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[10], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

partC = GraphicsGrid[{{DiscretePlot3D[Pxy[100][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 100)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[100], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)100][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 100)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[100], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

gridlab[x_] := Style[x, Black, Bold, 28, FontFamily->"Times New Roman"]
(*totalscoreasymmetrygrid = Grid[{
	gridlab[#]&/@{"A", "B"}, 
	{partA, partB},
	gridlab[#]&/@{"C", "D"}, 
	{partC, mitotalaldafig}}];
Export["totalscoreasymmetrygrid.pdf", totalscoreasymmetrygrid, "AllowRasterization"->True];*)

partA
partB 
partC 
mitotalaldafig

Supplemental Analysis: Mutual Information of the Alda A-Score

Here we repeat the analyses done for the total score using only the Alda A-scores.

Summary Table

irrdsA = Import["S2_File.csv", "Dataset", HeaderLines->1];

summaryA =Dataset[JoinAcross[Dataset[KeyValueMap[<|"Site"->#,"N Raters"->#2|>&,irrdsA[Counts, "Site"]]], 
Dataset[KeyValueMap[<|
"Site"->#1,"Case 1"->#2[[1]], "Case 2"->#2[[2]],
"Case 3"->#2[[3]],"Case 4"->#2[[4]],"Case 5"->#2[[5]],
"Case 6"->#2[[6]],"Case 7"->#2[[7]],"Case 8"->#2[[8]],
"Case 9"->#2[[9]],"Case 10"->#2[[10]],"Case 11"->#2[[11]],
"Case 12"->#2[[12]]|>&,irrdsA[GroupBy["site"],Round[N@Mean[#],0.1]&, Table["Case "<>ToString[i], {i, 12}]]]], 
"Site"]];
summaryA = TextGrid[Flatten[
	Catenate[{{{Normal@Keys[(summaryA^\[Transpose])]}},{List@@@Normal@summaryA}}],1], 
Frame->All]

X = Transpose[List@@@Normal@irrdsA[2;;, 4;;]];
y =  Flatten[List@@@Normal@irrdsA[{1}, 4;;]];
X = X[[Ordering[y]]];
y = y[[Ordering[y]]];

Plot the histograms

ascorehistfig = RatingHistogram[X, y]
(*Export["a-score-hist-fig.pdf", ascorehistfig, "AllowRasterization"->True];*)

Q[α_:2] := (({
	DirMulEstimate[Table[α, 11]][Table[Min[{Max[{X[[1]][[i]]-1, 0}], 10}], {i, Length@X[[1]]}]],
	DirMulEstimate[Table[α, 11]][X[[1]]],
	DirMulEstimate[Table[α, 11]][X[[1]]],
	DirMulEstimate[Table[α, 11]][X[[1]]],
	DirMulEstimate[Table[α, 11]][X[[2]]],
	DirMulEstimate[Table[α, 11]][X[[3]]],
	DirMulEstimate[Table[α, 11]][X[[4]]],
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 5, 7}]],
	(Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 5, 7}]] + 
		Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 8, 11}]])/2,
	Mean[Table[DirMulEstimate[Table[α, 11]][X[[k]]], {k, 8, 11}]],
	DirMulEstimate[Table[α, 11]][X[[12]]]
})^\[Transpose])

Thresholded Alda scores and joint distribution function:

ThresholdAlda[X_]:=Table[({{\[Piecewise], ({{0, x<7}, {1, True}})}}), {x, X}];
J[α_:2]:= {
(7/11)DirMulEstimate[Table[α, 2]][ThresholdAlda@Flatten@X[[;;6]]+1],
(4/11)DirMulEstimate[Table[α, 2]][ThresholdAlda@Flatten@X[[7;;]]+1]
}

Joint Distribution over True and Observed Scores

jointdistribaldaAscorefig = ArrayPlot[(Q[2]Table[(1/11), {i, 11}, {i, 11}]), 
PlotLabel->Style["Joint Distribution over True and Observed Alda-A Score", Black, 13],
PlotTheme->"Scientific",
ColorFunction->"ThermometerColors",
PlotLegends->Automatic, 
Frame->True,FrameStyle->Directive[Black, 13], 
FrameLabel->{"Observed Alda-A Score", "True Alda-A Score"},
 FrameTicks->{(({Range[11], Range[0, 10]})^\[Transpose]), (({Range[11], Range[0, 10]})^\[Transpose])}, ImageSize->350]
 
(*Export["jointdistributionaldascore.png", jointdistribaldaAscorefig, ImageResolution->500, "AllowRasterization"->True];*)

Pxy[α_]:= (Q[α]Table[(1/11), {i, 11}, {i, 11}]);
Px[α_]:= (Total@Pxy[α]);
Py[α_]:= Total[((Pxy[α])^\[Transpose])];
Jxy[α_]:= J[α];
Jx[α_]:= (Total@Jxy[α]);
Jy[α_]:= Total[((Jxy[α])^\[Transpose])];

AldaMI[α_]:=N@Total[Total[Pxy[α] Log[((Pxy[α])/(Px[α]⊗Py[α]))]]]
DiscreteAldaMI[α_]:=N@Total[Total[Jxy[α] Log[((Jxy[α])/(Jx[α]⊗Jy[α]))]]]

miaaldafig = Plot[
	{AldaMI[α], DiscreteAldaMI[α]}, {α, 2, 10}, 
	PlotStyle->63, Frame->True, FrameStyle->Directive[Black,15], 
	FrameLabel->{"α", "Mutual Information"}, 
	PlotTheme->"Scientific", 
	PlotLegends->Placed[{
		Style["Raw", Black, 16],
		Style["Dichotomized", Black, 16]}, 
		{0.75, 0.75}], 
	ImageSize->400];
(*Export["~/Desktop/mutualinformationaldascoresA.png", 
		miaaldafig, 
		ImageResolution->500, 
		"AllowRasterization"->True];*)

partA = GraphicsGrid[{{DiscretePlot3D[Pxy[0.0001][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 0)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[0.0001], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)0.0001][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 0)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[0.0001], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

partB = GraphicsGrid[{{DiscretePlot3D[Pxy[10][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 10)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[10], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)10][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 10)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[10], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

partC = GraphicsGrid[{{DiscretePlot3D[Pxy[100][[i,j]],{i,1,11}, {j,1,11}, ExtentSize->1/2,
PlotLabel->Style["Continuous Scale (α = 100)\n(Subscript[𝕀, α])[(Subscript[x, o])||(SubStar[x])]="<>ToString[Round[Re@AldaMI[100], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[x])", "(Subscript[x, o])", "p((Subscript[x, o]),(SubStar[x]))"},
AxesStyle->Directive[Black, 13]],
DiscretePlot3D[Jxy[ (11/2)100][[i,j]],{i,1,2}, {j,1,2}, ExtentSize->1/2,
PlotLabel->Style["Discretized Scale (α = 100)\n(Subscript[𝕀, γ])[(Subscript[y, o])||(SubStar[y])]="<>ToString[Round[DiscreteAldaMI[100], 0.01]], Black, 15],
PlotTheme->"Scientific", ColorFunction->"ThermometerColors", AxesLabel->{"(SubStar[y])", "(Subscript[y, o])", "p((Subscript[y, o]),(SubStar[y]))"},
AxesStyle->Directive[Black, 13], 
Ticks->{(({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), (({{1, 2}, {"(Li^((-)))", "(Li^((+)))"}})^\[Transpose]), Automatic}]}}, ImageSize->450, AspectRatio->1/1.1];

gridlab[x_] := Style[x, Black, Bold, 28, FontFamily->"Times New Roman"]
(*ascoreasymmetrygrid = Grid[{
	gridlab[#]&/@{"A", "B"}, 
	{partA, partB},
	gridlab[#]&/@{"C", "D"}, 
	{partC, miaaldafig}}];
Export["ascoreasymmetrygrid.pdf", ascoreasymmetrygrid, "AllowRasterization"->True];*)

partA
partB 
partC 
miaaldafig