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

dan7geo · Accepted Answer · 2017-06-15T07:41:11.047

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

func[531] should not list 53^1 (no exponent = 1). func[1111] should not list 11*11 (strictly increasing primes). — Hans Havermann, Jun 12 '17 at 09:50
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? — Hans Havermann, Jun 12 '17 at 10:18
The Groupings function is the bottleneck. It's too slow for more than 8 digits. Trying another method now. — dan7geo, Jun 12 '17 at 10:32
I've upped the ante by asking for output sort by ToExpression size (do-able if you keep track of the primes and their powers). My 49-digit example was computed by using someone else's Python script. I individually calculated (and then sorted by) the number of decimal digits. — Hans Havermann, Jun 13 '17 at 13:50
@HansHavermann Updated the answer. Now it works for large numbers. Haven't added the sorting and sizing yet. — dan7geo, Jun 15 '17 at 06:24
I'm impressed. This will help me with my exploration here. Thank you. — Hans Havermann, Jun 15 '17 at 11:24
I'm wondering if there are still fixable bottlenecks. My attempt to func[ToExpression["13^5323^853*96179"]] is running unresolved after many hours while someone else's Python code evaluated it almost immediately, albeit without the sorting and decimal-digits added. The 111-digit ToExpression["13^5323^853^9*617^9"] needed only 150 seconds to calculate and print out the 3472917-term list. — Hans Havermann, Jun 15 '17 at 21:46
Yes, this can be done through a more careful parsing of the sequence of primes in the input. I'll give it a try when I get time. — dan7geo, Jun 15 '17 at 23:11

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

1 Answers1