gen = makeGen[3]
relations=makeBraids[gen]
Erelations = {};

w = gen[[1]]<>gen[[3]]
reduceWord[w, relations, {}]

w = gen[[1]]<>gen[[2]]<>gen[[1]]
reduceWord[w, relations, {}]

w = gen[[1]]<>gen[[3]]<>gen[[2]]<>gen[[1]]
reduceWord[w, relations, {}]
reduceWordIRR[w,relations, Erelations,1000000]

w = gen[[1]]<>gen[[3]]<>gen[[2]]<>gen[[1]]<>gen[[2]]
reduceWord[w, relations, {}]
reduceWordIRR[w,relations, Erelations,1000000]

Example word which is irreducible in two different ways:

w = randWord[gen,10]
w1= reduceWordIRR[w,relations, Erelations,1000000]
rel2=randShuffle[relations];
w2=reduceWordIRR[w,rel2, Erelations,1000000]
w1===w2

Use the original relations and reduce step by step

v1=reduceWord[w,relations, Erelations]

v2=reduceWord[v1,relations, Erelations]

v3=reduceWord[v2,relations, Erelations]

No longer reduces:

reduceWord[v2,relations, Erelations]

Now use rel2 which was shuffeled version of relations:

t1=reduceWord[w,rel2, Erelations]

t2=reduceWord[t1,rel2, Erelations]

No longer reduces, but another reduction all together

reduceWord[t1,rel2, Erelations]

Below is an investigation into the repeated diminishing sequences of strings in a long word. By diminishing we mean the indicies decreasing but allow for repeatition. 

Basically the longest repeated strings are 8 in length and halve for random words as n grows, lesser for braided words. 

one-pass means the braid reductions applied once, for each relation.

many-pass means the braid relations applied repeatedly with accumulative effect no more than 1000000 iterations. 

500 strings were chosen in random locations in the middle of the long word. 

The output {6,2,3.146} means average repeated string length 6, minimum legnth 2 with average length of 3.146.

The righ-most graph shows the distribution of legnth of the 500 strings. 

Middle graph is frequency of occurance of the string in the long word.

The series of number:

421 max for repeated frequency of occurance by the 500 strings
2 min for the repeated  frequncy of occurance
167.298  Mean for the  repeated frequency of occurance 
172.459 standard deviation for the repeated frequency of occurance 


{421.`,2.`,167.298`,172.4585779781234`,,}

Random Word, 5-generators

gen = makeGen[5]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 5-generators, one-pass

gen = makeGen[5]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 5-generators, many-pass

gen = makeGen[5]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Word, 10-generators

gen = makeGen[10]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 10-generators, one-pass

gen = makeGen[10]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 10-generators, many-pass

gen = makeGen[10]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,10000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Word, 15-generators

gen = makeGen[15]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 15-generators, one-pass

gen = makeGen[15]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 15-generators, many-pass

gen = makeGen[15]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Word, 20-generator

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};
$Aborted
w = randWord[gen,30000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 20-generators, one-pass

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 20-generators, many-pass

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Word, 25-generators

gen = makeGen[25]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 25-generators, one-pass

gen = makeGen[25]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 25-generators, many-pass

gen = makeGen[25]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,30000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Word, 30-generators

gen = makeGen[30]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=w;

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 30-generators, one-pass

gen = makeGen[30]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWord[w,relations, Erelations];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

Random Braided Word, 30-generators, many-pass

gen = makeGen[30]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

wordlist={};
intervallist={};
freqlist={};
Table[
offset=RandomInteger[{100,200}];
res=findSeqMid[wIR, gen[[Length[gen]]],offset];
resnum=myTakePosition[wIR,findSeqMid[wIR, gen[[Length[gen]]],offset][[1]]];

If[ resnum > 1, AppendTo[freqlist,resnum];AppendTo[wordlist,res[[2]]];
AppendTo[intervallist,res[[1]]]], 
{i, 1, 500}];

wordlist;
intervallist;

{Max[intervallist[[All,2]]-intervallist[[All,1]]+1],
Min[intervallist[[All,2]]-intervallist[[All,1]]+1],
N[Mean[intervallist[[All,2]]-intervallist[[All,1]]+1]]}

{N[Max[freqlist]],
N[Min[freqlist]],
N[Mean[freqlist]],
Sqrt[N[Variance[freqlist]]],
ListPlot[freqlist, AxesOrigin->{0,0}, PlotRange->All],
ListPlot[intervallist[[All,2]]-intervallist[[All,1]]+1, AxesOrigin->{0,0}, PlotRange->All]}

These are intervals with no concerns for where they start and end. This approach was not acceptable, so the above replaced it and more reasonable to understasnd the underlying processes of braiding.

gen = makeGen[5]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=10+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}

gen = makeGen[10]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=10+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}

gen = makeGen[15]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=10+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=10+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=15+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}

gen = makeGen[20]
relations=makeBraids[gen]
Erelations = {};

w = randWord[gen,40000];

wIR=reduceWordIRR[w,relations, Erelations,1000000];

list=Table[c=RandomInteger[{20000,25000}];
n=30+c;
m=1+c;
myTakePosition[wIR, {m,n}], 
{i, 1, 500}];
{N[Max[list]],
N[Min[list]],
N[Mean[list]],
Sqrt[N[Variance[list]]],
ListPlot[list, AxesOrigin->{0,0}, PlotRange->All]}