# Generating prime factorizations from an integer's digits by inserting * and ^ into the digit sequence

Problem

Given a positive integer, output all possible valid prime-factorization "statements" thereof created by inserting zero or more multiplication (*) symbols and zero or more power (^) symbols into the digit sequence of the integer. Each statement is to be paired with the number of decimal digits in the "ToExpression" calculation of it and the entire list should be sorted by increasing "ToExpression" size.

In order for a prime-factorization statement to be valid, it must satisfy the following conditions:

• A single prime with or without an exponent is an acceptable output.
• It must be (broadly speaking) the product of powers of (left to right) strictly increasing primes.
• No prime and no exponent may begin with a zero.
• Because primes with an exponent of one are expressed without an exponent, no exponent may ever be one.

Here are some small inputs and their outputs:

11 -> {{11, 2}}; 12 -> {}; 23 -> {{2*3, 1}, {2^3, 1}, {23, 2}}; 24 -> {{2^4, 2}}; 235 -> {{2*3*5, 2}, {2^3*5, 2}, {2*3^5, 3}, {23^5, 7}, {2^35, 11}}; 531 -> {{5*31, 3}, {5^31, 22}}; 1111 -> {{11^11, 12}}; 7013 -> {{7013, 4}, {701^3, 9}}.

The procedure should be able to correctly handle large input integers even though this might result in long computes or oversized outputs. The sorting and sizing will obviously need to be done by arithmetic subterfuge. Here is a large input and its output:

4856435684257889399168067723732710466864629267287 -> {{4856435684257889^3*99168067723732710466864629267287, 80}, {4856435684257889^3991*68067723732710466864629267^287, 70019}, {4856435684257889^3991*68067723732710466864629^267287, 6165553}, {4856435684257889^399168067*723732710466864629267287, 6261477116}, {48564356842578893991680677237^32710466864629267287, 938342842682884262823}, {4856435684257889^399168067723732710466864629267287, 6261477102687158365511012881413778}}

func[n_]:=
Module[{f=Not@*PrimeQ@*ToExpression,seqs,splits,len
, digits=IntegerDigits@n,find,times,power,out},

power[a_,b_]:=ToString@a<>"^"<>ToString@b;
times[a_,b_]:=ToString@a<>"*"<>ToString@b;

seqs=SequencePosition[digits,_?(PrimeQ@*FromDigits),Overlaps->All];

splits =
With[{r = Flatten[
ReplaceList[#, {{{x___}, {___, {a_, b_}, y___}} /;
If[Length@{x} > 0,
FromDigits[Take[digits, {a, b}]] >
FromDigits[Take[digits, Last@{x}]],
True] :> {{x, {a, b}},
Select[{y}, #[] > b &]}
, {{x___}, {}} :> {{x}, {}}}] & /@ #, 1] &},
Flatten[FixedPointList[r,
Select[r@{{{}, seqs}}, #[[1, 1, 1]] == 1 &]][[;; , ;; , 1]]
, 1] /. {x___, {a_, b_}} /;
b < Length@digits :> {x, {a, b}, {b + 1, Length@digits}} //.
{x___, {a_, b_}, {c_, d_}, y___} /;
b < c - 1 :> {x, {a, b}, {b + 1, c - 1}, {c, d}, y} //
DeleteDuplicates];

find[m_List]:=
Select[StringJoin/@
DeleteCases[
StringSplit[Union@Groupings[m,{times->2,power->2}]
, {"*"->"*","^"->"^"}]
, {___,"^",_,"^",___}|
{___,_?f,"^",___}|
{_?f}|{___,"^","1",___}|
{___,"*",_?f,"*",___}|
{_?f,"*",___}|{___,"*",_?f}|
{___,_?(StringMatchQ[#,"0"~~___]&),___}]
, Less@@ToExpression@StringSplit[StringSplit[#,"*"],"^"][[;;,1]]&];

out = {find/@Map[StringJoin[ToString/@Take[digits,#]]&,splits,{2}]
, If[PrimeQ@n,ToString@n,Nothing]}//Flatten;

len[s_String] :=
Times @@@
MapAt[Log10,
ToExpression /@ StringSplit[StringSplit[s, "*"], "^"]
, {;; ,  1}] // Total ;

SortBy[{# , Ceiling@len@#} & /@ out
, N@*len@*First]
];


Usage:

    func
(*
{{4856435684257889^3*99168067723732710466864629267287,80},
{4856435684257889^3991*68067723732710466864629267^287,70019},
{4856435684257889^3991*68067723732710466864629^267287,6165553},
{4856435684257889^399168067*723732710466864629267287,6261477116},
{48564356842578893991680677237^32710466864629267287,938342842682884262823},
{4856435684257889^399168067723732710466864629267287,6261477102687158365511012881413778}}
*)

func
(* {{2*3*5,2},{2^3*5,2},{2*3^5,3},{23^5,7},{2^35,11}} *)

func
(* {{7013,4},{701^3,9}} *)

func
(* {} *)

func
(* {{2*3,1},{2^3,1},{23,2}} *)

func
(* {{2^4,2}} *)

func
(* {{5*31,3},{5^31,22}} *)

func
(* {{11^11,12}} *)

• func should not list 53^1 (no exponent = 1). func should not list 11*11 (strictly increasing primes). Jun 12, 2017 at 9:50
• @HansHavermann Fixed the bug! Jun 12, 2017 at 9:59
• I've added a large number proviso. I'm trying out your procedure on a 14-digit input. Is this going to get done in good time? Jun 12, 2017 at 10:18
• The Groupings function is the bottleneck. It's too slow for more than 8 digits. Trying another method now. Jun 12, 2017 at 10:32
• I'm impressed. This will help me with my exploration here. Thank you. Jun 15, 2017 at 11:24