Triangle+Fractions

From the LinkedIn Mathematica Users Group, Erin Gately asked:

//Greetings from Sunny Florida. :) I am new to Mathematica and need a starting point for translating fractions into colored points depending on repetitiveness. Any suggestions?//
with clarifying comment, // I am creating a figure (a triangle). The uppermost most point is 1/1. The lowermost row is 1/n, 2/n-1,...,(n-1)/2, n/1. These fractions will be denoted as points (graphic disks, colored according to repetitiveness...i.e. 1/2=2/4=3/6... will be gradients of the same color base). I am unsure if I should create this figure using a table in a loop, or if there is another way. //

Here is one solution: code With[{N = 50, size = 400, Colors = "TemperatureMap"}, Module[{point, frac, reduce, list1, list2, list3, list4, list5, counts, colors}, point[Null] := Sequence[]; point[list_] := With[{a = list1, b = list2}, Point[{(N - b + 2 a - 1)/2, N - b + 1}]]; frac[list_] := FractionBox[list1, list2 - list1 + 1]; reduce[frac_] := ReplaceAll[frac, FractionBox[a_, b_] :> a/b]; list1 = Table[{i, n}, {n, N}, {i, n}]; list2 = Map[{point[#], frac[#]} &, list1, {2}]; list3 = Flatten[list2All, All, 2]; list4 = reduce[list3]; counts = Apply[Rule, Tally[list4], 2]; colors = With[{max = Max[Last /@ counts]}, Table[ColorData[Colors][c/max], {c, max}]]; list5 = Map[{colorsreduce[Last[ /. counts]], PointSize[1/N], Tooltip[First[#], DisplayForm[Last[#]]]} &, list2, {2}]; Graphics[list5, ImageSize -> size] ]] code Here is the notebook with more details: