listTrunc:=proc(s,k) local n, start, finish, truncated, i; # create list from kth element onward (from n element list)

n:=nops(s);
start:=k-1;
finish:=n-k+1;
truncated:=[seq(0,i=1..finish)];

for i from 1 to finish do

  truncated[i]:=s[start+i];

od;

return(truncated);

end proc:


_12Pass:= proc(s,pass) local i,finish,n,places, count, result; 

n:=nops(s);

count:=0;

if (pass=1) then
  finish:=n-1;
elif (pass=2) then
  finish:=n;
fi;

for i from 2 to finish do

  if (s[1]<s[i]) then

    if (count=0) then
      places:=i;
    else
      places:=places,i;
    fi;
    count:=count+1;
  fi;

od;

if (count=0) then
  result:=[];
else
  result:=[places];
fi;

return(result);
end proc:


_21Pass:= proc(s,pass) local i,finish,n,places, count, result; 

n:=nops(s);

count:=0;

if (pass=1) then
  finish:=n-1;
elif (pass=2) then
  finish:=n;
fi;

for i from 2 to finish do

  if (s[1]>s[i]) then

    if (count=0) then
      places:=i;
    else
      places:=places,i;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:



_13Pass:= proc(s,pass) local i,finish,n,places, count, result; 

n:=nops(s);

count:=0;

if (pass=1) then
  finish:=n-1;
elif (pass=2) then
  finish:=n;
fi;

for i from 2 to finish do

  if (s[1]+1<s[i]) then

    if (count=0) then
      places:=i;
    else
      places:=places,i;
    fi;
    count:=count+1;
  fi;

od;

if (count=0) then
  result:=[];
else
  result:=[places];
fi;

return(result);
end proc:


_31Pass:= proc(s,pass) local i,finish,n,places, count, result; 

n:=nops(s);

count:=0;

if (pass=1) then
  finish:=n-1;
elif (pass=2) then
  finish:=n;
fi;

for i from 2 to finish do

  if (s[1]-1>s[i]) then

    if (count=0) then
      places:=i;
    else
      places:=places,i;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:



_132Restriction:=proc(chop1,vals2,offset) local n, i, places, count, result, consider; #to fix issue where 2>3 but <1, offset for truncation start

n:=nops(vals2);
count:=0;


for i from 1 to n do

  consider:=vals2[i]+offset-1;
  if (chop1[1]<chop1[consider]) then

    if (count=0) then
      places:=consider;
    else
      places:=places,consider;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:


_213Restriction:=proc(chop1,vals2,offset) local n, i, places, count, result, consider; #to fix issue where 2>3 but <1, offset for truncation start

n:=nops(vals2);
count:=0;


for i from 1 to n do

  consider:=vals2[i]+offset-1;


  if (chop1[1]<chop1[consider]) then

    if (count=0) then
      places:=consider;
    else
      places:=places,consider;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:

_231Restriction:=proc(chop1,vals2,offset) local n, i, places, count, result, consider; #to fix issue where 2>3 but <1, offset for truncation start

n:=nops(vals2);
count:=0;


for i from 1 to n do

  consider:=vals2[i]+offset-1;

  if (chop1[1]>chop1[consider]) then

    if (count=0) then
      places:=consider;
    else
      places:=places,consider;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:



_312Restriction:=proc(chop1,vals2,offset) local n, i, places, count, result, consider; #to fix issue where 2>3 but <1, offset for truncation start

n:=nops(vals2);
count:=0;


for i from 1 to n do

  consider:=vals2[i]+offset-1;

  if (chop1[1]>chop1[consider]) then

    if (count=0) then
      places:=consider;
    else
      places:=places,consider;
    fi;
    count:=count+1;
  fi;

od;


if (count=0) then
  result:=[];
else
  result:=[places];
fi;
return(result);
end proc:
#################################################################################################################################


_123Count:=proc(s,max,min) local n,i, j,chop1, vals1, finish1, chop2, vals2, count;

n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_12Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_12Pass(chop2,2);
    count:=count+nops(vals2);

    if (count>max) then
      return(false);
    fi;

  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:

_132Count:= proc(s,max,min) local n,i, j,chop1, vals1, finish1,chop2, vals2, vals3,count; 


n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_13Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_21Pass(chop2,2);
    vals3:=_132Restriction(chop1,vals2,vals1[j]);
    count:=count+nops(vals3);

    if count>max then
      return(false);
    fi;
  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:



_213Count:= proc(s,max,min) local n,i, j,chop1, vals1, finish1,chop2, vals2, vals3,count; 


n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_21Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_13Pass(chop2,2);
    vals3:=_213Restriction(chop1,vals2,vals1[j]);
    count:=count+nops(vals3);

    if count>max then
      return(false);
    fi;
  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:



_231Count:= proc(s,max,min) local n,i, j,chop1, vals1, finish1,chop2, vals2, vals3,count; 


n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_12Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_31Pass(chop2,2);
    vals3:=_231Restriction(chop1,vals2,vals1[j]);
    count:=count+nops(vals3);

    if count>max then
      return(false);
    fi;
  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:


_312Count:= proc(s,max,min) local n,i, j,chop1, vals1, finish1,chop2, vals2, vals3,count; 


n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_31Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_12Pass(chop2,2);
    vals3:=_312Restriction(chop1,vals2,vals1[j]);
    count:=count+nops(vals3);

    if count>max then
      return(false);
    fi;
  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:



_321Count:=proc(s,max,min) local n,i, j,chop1, vals1, finish1, chop2, vals2, count;

n:=nops(s);
count:=0;
for i from 1 to (n-2) do


  chop1:=listTrunc(s,i);
  vals1:=_21Pass(chop1,1);
  finish1:=nops(vals1);

  for j from 1 to finish1 do

    chop2:=listTrunc(chop1,vals1[j]);
    vals2:=_21Pass(chop2,2);
    count:=count+nops(vals2);

    if (count>max) then
      return(false);
    fi;

  od;
od;

if(count<min) then
  return(false);
else
return(count);

fi;
end proc:
#################################################################################################################################

P:=Permute(3):
P:-nextvalue();

_3Equitable:=proc(n) local max, min, i, finish, P, count, current,a1,a2,a3,a4,a5,a6;

max:=ceil(binomial(n,3)/6);
min:=floor(binomial(n,3)/6);
finish:=(n!);

P:=Permute(n);

count:=0;

for i from 1 to (n!) do

current:=P:-nextvalue();
current:=convert(current,listlist);

  a1:=type(_123Count(current,max,min),'integer');
  if a1 then
    a2:=type(_132Count(current,max,min),'integer');
    if a2 then
      a3:=type(_213Count(current,max,min),'integer');
      if a3 then
        a4:=type(_231Count(current,max,min),'integer');
        if a4 then
          a5:=type(_312Count(current,max,min),'integer');
          if a5 then
            a6:=type(_321Count(current,max,min),'integer');
            if a6 then
              count:=count+1;
print(current);

            fi;
          fi;
        fi;
      fi;
    fi;
  fi;

od;

return(count);

end proc:

%Y A000001 Cf. A000140