f[1] = {{}};
f[x_] := f[x] =
DeleteDuplicatesBy[
Flatten[Table[
Prepend[#, m] & /@ f[x/m], {m, Drop[Divisors[x], 1]}], 1], Sort];
f[1500]
{{2, 2, 3, 5, 5, 5}, {2, 2, 3, 5, 25}, {2, 2, 3, 125}, {2, 2, 5, 5, 15}, {2, 2, 5, 75},
{2, 2, 15, 25}, {2, 2, 375}, {2, 3, 5, 5, 10}, {2, 3, 5, 50}, {2, 3, 10, 25},
{2, 3, 250}, {2, 5, 5, 5, 6}, {2, 5, 5, 30}, {2, 5, 6, 25}, {2, 5, 10, 15},
{2, 5, 150}, {2, 6, 125}, {2, 10, 75}, {2, 15, 50}, {2, 25, 30}, {2, 750},
{3, 4, 5, 5, 5}, {3, 4, 5, 25}, {3, 4, 125}, {3, 5, 5, 20}, {3, 5, 10, 10},
{3, 5, 100}, {3, 10, 50}, {3, 20, 25}, {3, 500}, {4, 5, 5, 15}, {4, 5, 75},
{4, 15, 25}, {4, 375}, {5, 5, 5, 12}, {5, 5, 6, 10}, {5, 5, 60}, {5, 6, 50},
{5, 10, 30}, {5, 12, 25}, {5, 15, 20}, {5, 300}, {6, 10, 25}, {6, 250},
{10, 10, 15}, {10, 150}, {12, 125}, {15, 100}, {20, 75}, {25, 60},
{30, 50}, {1500}} |
