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

Question

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}}

Answer 1

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}, #[[1]] > 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[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[235]
    (* {{2*3*5,2},{2^3*5,2},{2*3^5,3},{23^5,7},{2^35,11}} *)

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

    func[12]
    (* {} *)

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

    func[24]
    (* {{2^4,2}} *)

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

    func[1111]
    (* {{11^11,12}} *)