Need help to finish this prime signature function?

Question

I'm trying to create a prime signature for line segments.

lpfSignature[n_, k_] :=
  Sort[Tally[Table[FactorInteger[m][[1, 1]], {m, n - k + 1, n }]]]
k = 10; n = k;
lpfSignature[n, k]
n = k^2;
lpfSignature[n, k]
n = k^2 + k;
lpfSignature[n, k]

$\{\{1,1\},\{2,5\},\{3,2\},\{5,1\},\{7,1\}\}$
$\{\{2,5\},\{3,2\},\{5,1\},\{7,1\},\{97,1\}\}$
$\{\{2,5\},\{3,1\},\{101,1\},\{103,1\},\{107,1\},\{109,1\}\}$

I want to strip the left-hand values to leave the following:

$\{1,5,2,1,1\}$
$\{5,2,1,1,1\}$
$\{5,1,1,1,1,1\}$

How would I change the function to do this?

Answer 1

The origin of the doublets is Tally of course :

k = 10; n = k;
Table[FactorInteger[m][[1, 1]], {m, n - k + 1, n}]
Tally[Table[FactorInteger[m][[1, 1]], {m, n - k + 1, n}]]

(* {1, 2, 3, 2, 5, 2, 7, 2, 3, 2} *)
(* {{1, 1}, {2, 5}, {3, 2}, {5, 1}, {7, 1}} *)

If you are only interested in the multiplicity you can modify your function as :

lpfSignature[n_, k_] := Sort[Tally[Table[FactorInteger[m][[1, 1]], {m, n - k + 1, n}]][[All,2]]]

Alternatively you can leave your function as it is but use it as :

k = 10; n = k;
lpfSignature[n, k][[All,2]]

(* {1, 5, 2, 1, 1} *)