4
$\begingroup$

Assume we give the value from 1 to 26 to alphabets a,b,...,z.

Now given an integer ($n$) i like to generate words of specific length ($l$) that sum of them equals $n$. For instance, if $n=10$, $l=3$;

{aah,abg,acf,ade,aed,afc,agb,aha,bag,bbf,bce,bdd,bec,bfb,bga,caf,cbe,ccd,cdc,ceb,cfa,dae,dbd,dcc,ddb,dea,ead,ebc,ecb,eda,fac,fbb,fca,gab,gba,haa}

with more clear representation:

{aah,abg,acf,ade,aed,afc,agb,aha,
bag,bbf,bce,bdd,bec,bfb,bga,
caf,cbe,ccd,cdc,ceb,cfa,
dae,dbd,dcc,ddb,dea,
ead,ebc,ecb,eda,
fac,fbb,fca,
gab,gba,
haa}

How can I write this code in Mathematica. Is teere any predefine function to do this job for me?

$\endgroup$

6 Answers 6

6
$\begingroup$
Clear["Global`*"];

n = 10; l = 3;
letters = Alphabet[];
iparts = IntegerPartitions[n, {l}];
idx = Permutations /@ iparts // Flatten[#, 1] & // Sort
idx // Map[letters[[#]] &] // Map[StringJoin] // 
  SplitBy[#, StringTake[#, 1] &] & // Grid

enter image description here


EDIT-1

You can get the list called res, and for cases such as follows:

n = 10; l = 5;
res = idx // Map[letters[[#]] &] // Map[StringJoin] // 
    SplitBy[#, StringTake[#, 1] &] &)

For a different presentation, try:

Framed /@ res // Column
$\endgroup$
6
  • $\begingroup$ thans @Syed, when I change $l$ to bigger integer, the representation is splitting to separate lines, is it possible to solve this problem? $\endgroup$
    – asad
    Oct 24, 2023 at 13:33
  • $\begingroup$ ps. thans->thanks $\endgroup$
    – asad
    Oct 24, 2023 at 13:45
  • $\begingroup$ How big is "bigger"? Anything involving integer partitions and permutations reaches its limits soon. Or are you talking about the presentation part? $\endgroup$
    – Syed
    Oct 24, 2023 at 13:55
  • $\begingroup$ for instance I set l=5, it splits each word in 4 lines! please see the output image here: ibb.co/qrqDCn0 $\endgroup$
    – asad
    Oct 24, 2023 at 14:08
  • $\begingroup$ Can't display what can't fit on the screen. Use (res = idx // Map[letters[[#]] &] // Map[StringJoin] // SplitBy[#, StringTake[#, 1] &] &) // Grid. This way the variable res will have the list that you can use as you please. $\endgroup$
    – Syed
    Oct 24, 2023 at 14:13
5
$\begingroup$

Update

StringJoin@*FromLetterNumber/@Pick[#,
  ContainsNone[{0}]/@#]& [FrobeniusSolve[{1,1,1},10]]

 (* {aah,abg,acf,ade,aed,afc,agb,aha,bag,bbf,bce,bdd,bec,bfb,bga,
     caf,cbe,ccd,cdc,ceb,cfa,dae,dbd,dcc,ddb,dea,ead,ebc,ecb,eda,
     fac,fbb,fca,gab,gba,haa} *) 

Original Answer

StringJoin@*FromLetterNumber/@Pick[#,Total/@#,10]&[Tuples[Range[10],{3}]]


(* {aah,abg,acf,ade,aed,afc,agb,aha,bag,bbf,bce,bdd,bec,bfb,bga,
    caf,cbe,ccd,cdc,ceb,cfa,dae,dbd,dcc,ddb,dea,ead,ebc,ecb,eda,
    fac,fbb,fca,gab,gba,haa} *)

Or

StringJoin@*FromLetterNumber /@ Catenate[Permutations /@ IntegerPartitions[26, 
  {3}]] // Sort // Short

(* {aax,abw,acv,adu,aet,afs,agr,ahq,<<284>>,ucb,uda,vac,vbb,vca,wab,wba,xaa} *)

Just for fun

 StringJoin@*FromLetterNumber /@ Catenate[Permutations /@ IntegerPartitions[26, 
  {8}]] // Sort // Short

(* {aaaaaaas,aaaaaabr,aaaaaacq,aaaaaadp,aaaaaaeo,<<480691>>,
    raabaaaa,rabaaaaa,rbaaaaaa,saaaaaaa} *)
$\endgroup$
4
$\begingroup$
Words[wordSum_, letterCount_] :=
  StringJoin[Part[Alphabet[], #]] & /@ 
    Flatten[Permutations /@ IntegerPartitions[wordSum, {letterCount}], 1];

Words[10, 3]
(*   
   {haa,aha,aah,gba,gab,bga,bag,agb,abg,fca,fac,cfa,caf,afc,acf,fbb,bfb,bbf,
    eda,ead,dea,dae,aed,ade,ecb,ebc,ceb,cbe,bec,bce,ddb,dbd,bdd,dcc,cdc,ccd} 
*)

From that you can apply whatever sorting and presentation you want.

For example, if words is the result of Words[10,3] (I've prettified the output, it's just a list of lists):

GatherBy[Sort[words], StringTake[#, 1] &]
(*
  {{"aah", "abg", "acf", "ade", "aed", "afc", "agb", "aha"},
   {"bag", "bbf", "bce", "bdd", "bec", "bfb", "bga"}, 
   {"caf", "cbe", "ccd", "cdc", "ceb", "cfa"}, 
   {"dae", "dbd", "dcc", "ddb", "dea"}, 
   {"ead", "ebc", "ecb", "eda"}, 
   {"fac", "fbb", "fca"}, 
   {"gab", "gba"}, 
   {"haa"}}
*)

Wrapping that with Grid might be what you want for final display.

$\endgroup$
3
$\begingroup$

A 2-liner?

  FromCharacterCode /@ (Permutations /@ 
   Select[Tuples[Range[26], 3], (Total[#] == 10 &)]+ToCharacterCode["a"][[1]]-1)
   //Flatten// Union

   {"aah", "abg", "acf", "ade", "aed", "afc", "agb", "aha", "bag", 
     "bbf", "bce", "bdd", "bec", "bfb", "bga", "caf", "cbe", "ccd", 
     "cdc", "ceb", "cfa", "dae", "dbd", "dcc", "ddb", "dea", "ead", 
     "ebc", "ecb", "eda", "fac", "fbb", "fca", "gab", "gba", "haa"}
$\endgroup$
3
$\begingroup$

Get ways of expressing the number sum as len digits between 1 and 26:

 expressions = 
   FromLetterNumber /@ IntegerPartitions[sum, {len}, Range@26];

And get all the permutations of each expression:

Flatten[Permutations /@ expressions, 1] // Sort;

As a function for general input, producing your desired output format:

getWords[sum_, len_] :=
 (
  expressions = 
   FromLetterNumber /@ IntegerPartitions[sum, {len}, Range@26];

  perms =Flatten[Permutations /@ expressions, 1] // Sort;


GatherBy[ StringJoin /@ perms, StringPart[#, 1] &] // Grid
  )

And reproducing your example:

getWords[10, 3]

Mathematica graphics

$\endgroup$
2
$\begingroup$
n = 10;

l = 3;

Using SequenceCases and Syed's permutations

SequenceCases[
  Alphabet[][[#]] & /@
    Sort @ Catenate @ Map[Permutations] @ IntegerPartitions[n, {l}],
  x : {{a_, __}, {a_, __} ...} :> StringJoin /@ x] // Grid

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.