restart;
with(combinat):with(networks):with(plottools):

#(1)A procedure to check if a given collection over X is topology or not .

CheckTopology:=proc(X,T)

local i,O,CT,CuT;

CT:={};

if `subset`(T,PowerSetof(X))=true then

for O in T do

CuT:={seq(O intersect T[i],i=1..nops(T)),seq(O union T[i],i=1..nops(T))};

CT:=CT union CuT;

od;

CT;

CT:= CT union {{},X};

evalb(CT=T);
if evalb(CT=T)=true then True ;

else "False this collection does not represent a topology";
fi;
else "False this collection is no a sub collection of the powerset";
fi;

end:

#(2) A procedure to obtain a relative topology on a subset of X.
SubSpace:=proc(A,X,T)
if (`subset`(A,X) and `subset`(T,PowerSetof(X))and CheckTopology(X,T))=True then  
map2(`intersect`,A,T);
else "False check your entries";
fi;
end:

#(3) A procedure to check if a given point is a boundary point or not.

CheckBoundary:=proc(x,A,X,T)

local O,t,o,B;

O:={};

B:={};

if (member(x,X)and`subset`(A,X)) then

for  t in T do

if member(x,t) then O:= O union {t};

else O:=O;

fi;

od;

O;

for o in O do

if (o intersect A )<> {} and (o intersect X minus A) <>{} then B:=B union {x};

else B:={};break;

fi;

od;

B;

else false;

fi;

B;

if B={} then "It's not a boundary point of the given set";

else B:={x};

fi;

end:

#(4) A procedure to find all boundary points of a given Set.

BoundaryPoints:=proc(A,X,T)

local CB,x;

CB:={};

if `subset`(A,X) then

for x in X do

if CheckBoundary(x,A,X,T)<>"It's not a boundary point of the given set" then CB:= CB union {x};

else CB:= CB;

fi;

od;

CB;
else false;

fi;
if CB={} then "The given set has no boundary points";else CB;
fi;

end:

#(5) A procedure to check if a given point is interior point or not.

CheckInterior:=proc(x,A,X,T)

local O,In,eO,o;

In:={};

eO:={};

if(`member`(x,X) and `subset`(A,X) ) then

for O in T do

if `member`(x,O) then eO:=eO union {O};

else eO:=eO;

fi;

od;

for o in eO do

if `subset`(o,A) then In:=In union {x};

else In:=In;

fi;

od;

In;

else false;

fi;

if In={} then "It's not an interior point of the given set";

else In:={x};

fi;

end:

#(6) A procedure to find all interior points of a given set.

InteriorPoints:=proc(A,X,T)

local x,ci,d,i;

ci:={};

if `subset`(A,X)=true then

for x in X do

if CheckInterior(x,A,X,T)<>"It's not an interior point of the given set" then ci:=ci union {x};

else ci:=ci;

fi;

od;

else print(false);

fi;

ci;
if ci={} then "The given set has no interior points"; else
ci;
fi;

end:

#(7) A procedure to check if a given point is a closure point or not.

CheckClosure:=proc(x,A,X,T)

local c,o,cp,co;

co:={};

cp:={};

if `member`(x,X) and `subset`(A,X) then

for o in T do

if `member`(x,o) then co:=co union {o} ;else co:=co;

fi;

od;

co;

for c in co do

if c intersect A<>{} then cp:=cp union {x};

else cp:={};break;

fi;

od;

cp;

else false;

fi;

cp;

if cp={} then "It's not a closure point of the given set";

else cp:={x};

fi;

end:

#(8) A procedure to find all closure points of a given set.

ClosurePoints:=proc(A,X,T)

local C,t,i,x;

C:={};

if `subset`(A,X) then

for x in X do

if CheckClosure(x,A,X,T)<>"It's not a closure point of the given set" then C:=C union {x};

else C:=C;

fi;

od;

C;

else false;

fi;
if C={} then "The given set has no closure points";else C;
fi;
C;

end:
 

#(9)A procedure to check if a given point is an exterior point of a given subset or not.

CheckExterior:=proc(x,A,X,T)

local CX,O,ex,i;

CX:= X minus A;

ex:={};

if (member(x,X)and`subset`(A,X)) then

for O in T do

if `member`(x,O) and `subset`(O,CX) then ex:=ex union {x};

else ex:=ex;

fi;        

od;

ex;

if ex={} then "It's not an exterior point of the given set " ;

else ex:={x};

fi;

else false;

fi;

end:

#(10) A procedure to find all exterior points of a given subset.

ExteriorPoints:=proc(A,X,T)

local ext,x;

ext:={};

if `subset`(A,X) then

for x in X do

if CheckExterior(x,A,X,T)<>"It's not an exterior point of the given set " then ext:=ext union {x};

else ext:=ext;

fi;

od;

ext;
if ext={} then"The given set has no exterior points";
else ext;fi;
else false;
fi;

end:

 #(11) A procedure to check if a given point is a limit  point or not.

 CheckLimit:=proc(x,A,X,T)

local i,o,L,Omx,O;

O:={};

L:={};

if member(x,X)= true then

for i to nops(T) do

if (member(x,T[i]))then O:= O union {T[i]};

else O:=O;

fi;

od;

Omx:={seq(O[i] minus {x},i=1..nops(O))};

for o in  Omx do

if ((o intersect A) <> {}) then L:=L union {x};

else L:={};

break;

fi;

od;

L;

else false;

fi;

L;

if L={} then "It's not a limit point of the given set ";else

L:={x};

fi;

end:

#(12)A procedure to find all limit points of a given set of X.

 LimitPoints:=proc(A,X,T)

local x,LI;

LI:={};

if `subset`(A,X)=true then

for x in X do

if CheckLimit(x,A,X,T) <> "It's not a limit point of the given set " then LI:=LI union {x};

else LI:=LI;

fi;

od;

LI;
if LI={} then "The given set has no limit points";else LI;
fi;   

else false ;

fi;

end:

#(13)A procedure to check if a given point is isolated point or not.

CheckIsolated:=proc(x,A,X,T)

local o,iso;

iso:={};

if (member(x,X)and`subset`(A,X) and `subset`(T,PowerSetof(X))) then

for o in T do  

if o intersect A ={x} then iso:=iso union {x};break;

else iso:=iso;

fi;

od;

iso;

if iso={} then "It's not an isolated point of the given set"; else

iso:={x};        

fi;

else false;

fi;

end:

#(14) A procedure to find all isolated points of a given subset.

IsolatedPoints:=proc(A,X,T)

local isol,x;

isol:={};

if `subset`(A,X) then

for x in X do

if CheckIsolated(x,A,X,T)<>"It's not an isolated point of the given set" then

 isol:=isol union {x};

else isol:=isol;

fi;

od;

isol;
if isol={} then "The given set has no isolated points";else isol;
fi;

else false;
fi;

end:

#(15)A procedure to find the closed sets of the topology.

ClosedSets:=proc(X,T)

{seq(X  minus T[i],i=1..nops(T))};

end:

#(16)A procedure to find the clopen sets of the topology.

ClopenSets:=proc(X,T)

local A,W;

W:={};

for A in T do

if `member`(X minus A,T)=true then W:=W union {A};
else W:=W;
fi;

od;

W;

end:

#(17)A procedure to find the neither open nor closed setes in a given topology.
NeitherOpenNorClosedSets:=proc(X,T)
local A,B,C;
if CheckTopology(X,T)=True then
A:=PowerSetof(X) minus T;
A;
B:=A minus ClosedSets(X,T);
B;
C:=B minus ClopenSets(X,T);
C;
else "Please check your entries!!!";fi;
if C={} then "There are no neither open nor closed sets of the given space";
else; C;
fi;
end:

#(18)A procedure to check if a given topology is T0 or not.

CheckT0:=proc(X,T)

local x,y,O,test;

if nops(X)=1 then print("True") ;else

for x in X do

for y in X minus{x} do

for O in T do

test:=evalb((member(x,O)and not(member(y,O)))or (member(y,O) and not(member(x,O))));

if test then break; fi;

od:

if not(test) then break;fi;

od:

if not(test) then break;fi;

od:

fi;

test;

end:

#(19)A procedure to find  all topologies over a given set.

AllTopologies:=proc(X)

local T,ALLTOPO;

ALLTOPO:={};

for T in CollectionsUnionEmptyandFullSet(X) do

if CheckTopology(X,T)=True then ALLTOPO:=ALLTOPO union {T};else

ALLTOPO:=ALLTOPO;

fi;

od;

ALLTOPO;

end:

#(20)A procedure to find the number of topologies over a given set.
NumberofTopologies:=proc(X)

print("There are",nops(AllTopologies(X)),"topologies over a set with",nops(X),"points");

end:

#(21) A procedure to find all T0 topologies over a given set.

AllT0Topologies:=proc(X)

local i,T,T0S;

T0S:={};

AllTopologies(X);

if nops(X)=1 then T0S:=AllTopologies(X);else

for T in AllTopologies(X) do

if CheckT0(X,T)=true then T0S:= T0S union {T} ; else T0S:=T0S;

fi;

od;

fi;

T0S;

end:

#(22)A procedure to find the number of T0 topologies over a given set.

NumberofT0Topologies:=proc(X)

print("There are",nops(AllT0Topologies(X))," T0 topologies over a set with",nops(X),"points");

end:

#(23)A procedure to generate a topology from a given subbasis S.

GenerateTopologybySubBasis:=proc(X,S)

 local i,O,GT1,GT2,T,B;

    B:={};

    T:={{}};

 for O in S do

GT1:={seq(O intersect S[i],i=1..nops(S))} ; B:=B union GT1;

 od;

  B:=B union {X};

for O in B do

GT2:={seq(O union B[i],i=1..nops(B))};

  B:= B union GT2;

od;

 T union B;

end:

#(24) A procedure to find the minimal basic open set for a certain point x.

MinimalBasic:= proc(x,X,T)

local i,O,COUNT;

COUNT:={};

if (member(x,X) and CheckTopology(X,T)=True) then

for O in T do

if member(x,O)then COUNT:=COUNT union {O};

else COUNT:=COUNT;

fi;

od;

COUNT;

COUNT[1];

else false;

fi;

end:

#(25) A procedure to find the minimal basis of a given topological space.

MinimalBasis:=proc(X,T)

local x,minimalbasis;

minimalbasis:={};

if `subset`(T,PowerSetof(X))then

for x in X do

minimalbasis:=minimalbasis union {MinimalBasic(x,X,T)};

od;

minimalbasis;

else print("Check the colllection  !!");

fi;

end:


#(26)A procedure to close a given set under unions needed in other procedure.

CloseUnions:=proc(T)

local A,U;U:=T;

for A in T do

U:=U union map(`union`,U,A);

od;

if U=T then U; else CloseUnions(U); fi;

end:

#(27)A procedure to close agiven set under intersections needed in other procedure.

CloseIntersections:=proc(T)

local A,U;U:=T;

for A in T do

U:=U union map(`intersect`,U,A);

od;

if U=T then U; else CloseIntersections(U); fi;

end:

#(28)A procedure to check that if the topology is connected.

CheckConnected:=proc(X,T)

evalb(ClopenSets(X,T)={X,{}});
end:

#(29)A procedure to find all connected topologies over a given set.
AllConnectedSpaces:=proc(X)
local C,c;
C:={};
AllTopologies(X);
for c in AllTopologies(X) do
if CheckConnected(X,c)=true then C:= C union {c};
else;
C:=C;
fi;
od;
C;
end:

#(30)A procedure to find the number of connected spaces over a given set.
NumberofConnectedSpaces:=proc(X)
print(`There are`,nops(AllConnectedSpaces(X)),`connected spaces over a set with`,nops(X),`points`);
end:

#(31) A procedure to find the connected components of a given point.

ConnectedComponents:=proc(x,X,T)

local i,S,SK;

SK:={};

S:=map2(`union`,{x},powerset(X));

for i to nops(S) do

if CheckConnected(S[i],SubSpace(S[i],X,T)) then SK:=SK union S[i];fi;

od; SK ;

end:

#(32) A procedure to find all connected components of a given space.
AllConnectedComponentsTopology:=proc(X,T)
local x,CC;
CC:={};
for x in X do
CC:=CC union {ConnectedComponents(x,X,T)};
od;
CC;
end:
 
#(33)A procedure to check if a Topology is Totaly Disconnected.

CheckTotalyDisconnected:=proc(X,T)

local i;
if CheckTopology(X,T)=True then

for i to nops(X) do

if not(ConnectedComponents(X[i],X,T)={X[i]}) then RETURN(false)fi;

od;

RETURN(true);
else "Please check your enteries!!!";fi;

end:

#(34) A procedure to find all totaly disconnected space over a given set.
AllTotalyDisconnected:=proc(X)
local o,T;T:={};
AllTopologies(X);
for o in AllTopologies(X) do
if CheckTotalyDisconnected(X,o)=true then T:=T union {o};else
T:=T;
fi;
od;
end:

#(35) A procedure to find the number of totaly disconnected spaces over a given set.
NumberofTotalyDisconnectedSpaces:=proc(X)
AllTotalyDisconnected(X);
print(`There are`,nops(AllTotalyDisconnected(X        )),`over a set with `,nops(X),`points`);
end:

#(36)A procedure to find all disconnected spces over a given set.
AllDisconnectedSpaces:=proc(X)
AllTopologies(X) minus AllConnectedSpaces(X);
end:

#(37)A procedure to find the number of disconnected spaces over a given set given set.
 NumberofDisconnectedSpaces:=proc(X)
print(`There are`,nops(AllDisconnectedSpaces(X)),`disconnected spaces over a set with`,nops(X),`points`);
end:

#(38)A procedure to check if a given topology is weakly-dimensional or not.
CheckWeaklyDimensional:=proc(X,T)
if CheckTopology(X,T)=True then
 evalb(GenerateTopologybySubBasis(X,ClopenSets(X,T))=T)
else "Please Check your entries";
fi;
 end:

#(39)A procedure to find all waekaly-dimensional topology over a given set.
AllWeaklyDimensionalSpaces:=proc(X)
local W,o;
W:={};
AllTopologies(X);
for o in AllTopologies(X)do
if CheckWeaklyDimensional(X,o)=true
then W:=W union {o};
else         W:=W;
fi;
od;
end:

#(40)A procedure to find the number of weakaly-dimensional topologies over a given set.
NumberofWeaklyDimensionalSpaces:=proc(X)
print(`There are`,nops(AllWeaklyDimensionalSpaces(X)),`weakly-dimensional topologies over a set with`,nops(X),`points`);
end:

#(41) A procedure to Generate Extremal Topology Over X by x,y.

GenerateExtremalTopology:=proc(x,y,X)

local o,c,t,e,px,py,M,txy;

if `member`(x,X) and `member`(y,X) and x<>y then

c:={};M:={};txy:={};

px:=PowerSetof(X minus {x});

for o in px do

if `member`(y,o) then

c:=c union {o};

else c:=c;

fi;

od;

c;

for e in c do

txy:=e union {x};

M:=M union {txy};

od;

px union M;

else flase;

fi;

end:

#(42)A proceure to find all extremal topologies over a finite set X.
AllExtremalTopologies:=proc(n)

local EX,x,y,pp,X;

EX:={};

X:={seq(x[i],i=1..n)};

for x in X do

for y in X minus {x} do

EX:=EX union {GenerateExtremalTopology(x,y,X)};

od;

od;

EX;

end:

#(43)A Procdure to Find the Number of  Extremal Topologies Over a Set with n Points.

NumberofExtremalTopologies:=proc(n)

print("There are ",nops(AllExtremalTopologies(n)),"extremal topologies over a set with",n,"points");

end:

#(44) A procdure to find the  Non-Trivial Minimal Topologies Over a Set with n Points.
AllNonTrivialMinimalTopologies:=proc(n)

local o,c,X,PX,T;

c:={};T:={};

X:={seq(x[i],i=1..n)};

PX:=PowerSetof(X);

for o in PX do

c:=c union{{{},o,X}};

od;

c minus {{{},X}};

end:

#(45) A Procdure to Find the Number of Non-Trivial Minimal Topologies Over a Set with n Points.
NumberofNonTrivialMinimalTopologies:=proc(n)

print("There are",nops(AllNonTrivialMinimalTopologies(n)),"non trivial minimal topologies over a set with",n,"oints");

end:

#(46)A Procdure to Find the Number of Open set in Generated Extremal Topologies.

NumberofOpenSetsExtremal:=proc(x,y,X)

print("Number of open setes is",nops(GenerateExtremalTopology(x,y,X)));

end:

#(47) A procedure to find the Cartesian product between two given sets.

Expandcart:=proc(PX)

local C,P,i;

C:={};

P:=cartprod([seq([op(PX[i])],i=1..nops(PX))]);

while not P[finished] do C:=C union{P[nextvalue]()}od;

C;

end:

#(48)A procedure to Implementation of the inverse projections, this is needed in later procedures.

InverseProj:=proc(k,S,PX)

local i,O;

for i to nops(PX) do

if i=k then O[i]:=S else O[i]:=PX[i] fi;

od;

Expandcart([seq(O[i],i=1..nops(PX))]);

end:

#(49) A procedure to find subbasis for product topology using inverse projections.

ProductBase:=proc(PX,PS)

local i,k,S;S:={};

for k to nops (PX) do

for i to nops(PS[k]) do

S:=S union {InverseProj(k,PS[k][i],PX)};

od;

od;

S;

end:

#(50) A procedure to give alist of sets and alist of topologis,the product topology is found?.

ProductTopology:=proc(PX,PT)

GenerateTopologybySubBasis(Expandcart(PX),ProductBase(PX,PT));

end:

#(51)A procedure to plot Hass digram over a given space.

SetLattice:=proc(S)

local a,b,G,os,i,j,lorder,P,L,T,k,tl,dincl;

dincl:=proc(A,B,S)

local C;

if A=B then RETURN(false) fi;

if not `subset`(A,B)then RETURN(false) fi;

for C in S minus {A,B} do

if `subset`(A,C)and `subset`(C,B)then RETURN(false) fi;

od;

RETURN(true);

end:

lorder:=proc(a,b)evalb(nops(a)<nops(b))end :

new(G);

os:=sort([op(S)],lorder);

addvertex({seq(i,i=1..nops(S))},G);

for i to nops(os) do

for j to nops(os) do

if dincl(os[i],os[j],S)then addedge([i,j],G)fi;

od;

od;

k:=nops(os[1]);

tl:=1;

T:={};

for i to nops(os) do

print(i=os[i]);

if nops(os[i])=k then T:=T union {i};

else

L[tl]:=T;

T:={i};

tl:=tl+1;

k:=nops(os[i]);

fi;

od;

L[tl]:=T;

P:=draw(Linear(seq([op(L[i])],i=1..tl)),G);

print(rotate(P,Pi/2));

G;

end:

#(52)A procedure to finid the power set.

PowerSetof:=proc(X)

local Y;

Y:=powerset(X);

end:

#(53)A procedure to find all proper sets over a given set.

ProperSubsetsof:=proc(X)

local Z;

Z:=PowerSetof(X) minus{{},X};

end:

#(54)A procedure to find  proper sets collections over a given set.

CollectionsbyProperSubsets:=proc(X)

local W;

W:=PowerSetof(ProperSubsetsof(X));

end:

#(55)A procedure  proper sets collections over a given set union {{},Full Set}.

CollectionsUnionEmptyandFullSet:=proc(X)

{seq(w union{{},X},w=CollectionsbyProperSubsets(X))};

end:

#(56) A procedure to apply a permutation p of the elements of a space to the sets in a topology t is needed in later preocedure.
newjob:=proc(t,p)
local u:
 {seq(subs({seq(X[i]=p[i],i=1..nops(X))} ,u) ,u=t)}:
end:

#(57)A procedure to compare sizes between a given topologies is needed in the following topology.
 bigger:=proc(t1,t2)
if nops(t1) < nops(t2) then true else false fi:
end:

#(58) A procedure to Check if two topologies are homeomoprhic or not.
IsHomeomorphic:=proc(t1,t2,X)
local answer, P,p;
if (CheckTopology(X,t1)="False this collection does not represent a topology" or CheckTopology(X,t2)="False this collection does not represent a topology" or not`subset`(t1,PowerSetof(X)) or not`subset`(t2,PowerSetof(X))) then "There are some mistaiks in your inputs please check it!"; else
p:=permute(X);
 #we can first check for some trivial invariants, such as.
 if nops(t1) <> nops(t2) then return(false) fi:
 answer:=false:
 for p in P do
if {op(newjob(t1,p))}={op(t2)} then answer:=true: break: fi:od:
 #Note that we have to compare _sets_ rather than _lists_!.
 answer:
fi;
end:

#(59)A procedure to find the proper disjoint closed sets.
DisjointProperClosedSets:=proc(X,T)
local c,p,o,SC,CC;
SC:={};
CC:=ClosedSets(X,T) minus {{},X};
for c in CC do
for p in CC minus c do
if c intersect p ={}  then SC:=SC union {c,p};
else SC:=SC;
fi;
od;od;
SC;
end:

#(60)A procedure to find the disjoint proper open sets of a given topological space.
DisjointProperOpenSets:=proc(X,T)
local o,m,D,PO;
D:={};
PO:=T minus {{},X};
for o in PO do
for m in PO minus {o} do
if o intersect m ={} then D:=D union {o,m};else D:=D;
fi;od;od;
D;
end:

#(61) A procedure to find disoint closed sets in pairs {,}.
DisjointClosedinPairs:=proc(X,T)
local f,c,C,M;
C:={};
M:=ClosedSets(X,T)minus {{}};
for f in M do
for c in M minus {f} do
if c intersect f={} then C:=C union {{c,f}};
else C:=C;
fi;
od;
od;
C;
end:

#(62) A procedure to check if a given space is normal or not.
CheckNormal:=proc(X,T)
local o,p,c,s,F;
F:={};
if nops(T)=2 or nops(T)=3 or  DisjointClosedinPairs(X,T)={} then true;
else
for o in DisjointProperOpenSets(X,T) do
for c in DisjointProperClosedSets(X,T) do
for p in DisjointProperOpenSets(X,T) minus {o} do
for s in DisjointProperClosedSets(X,T) minus {c} do
if`subset`(c,o)and `subset`(s,p) then F:=((F union {o})union {p});
else F:=F;
fi;
od;
od;
od;
od;
F;
if F={}then false; else true;
fi;
fi;
end:

#(63)A procedure to find all Normal spaces over a given set.
AllNormalSpaces:=proc(X)
local o,N;
N:={};
AllTopologies(X);
for o in AllTopologies(X) do
if CheckNormal(X,o)=true then N:=N union {o};
else N:=N;
fi;
od;
N;
end:

#(64)A procedure to find the number of normal spaces over a given set.
NumberofNormalSpaces:=proc(X)
AllNormalSpaces(X);
print(`There are`,nops(AllNormalSpaces(X)),`Normal spaces over a set with`,nops(X),`points`);
end:

#(65) A procedure  to find non normal Spaces over a given set.
NonNormalSpaces:=proc(X)
AllTopologies(X) minus AllNormalSpaces(X);
end:

#Implementations;

X:={a,b,c};

T:={{}, {a}, {a, b}, {a, c}, {a, b, c}};

CheckTopology(X,T);

A:={b,c};

SubSpace(A,X,T);

CheckBoundary(a,A,X,T);

BoundaryPoints(A,X,T);

CheckInterior(c,A,X,T);

InteriorPoints(A,X,T);

CheckClosure(c,A,X,T);

ClosurePoints(A,X,T);

CheckExterior(b,A,X,T);

ExteriorPoints(A,X,T);

CheckLimit(c,A,X,T);

LimitPoints(A,X,T);

CheckIsolated(b,A,X,T);

IsolatedPoints(A,X,T);

ClosedSets(X,T);

ClopenSets(X,T);

NeitherOpenNorClosedSets(X,T);

CheckT0(X,T);

AllTopologies(X);

NumberofTopologies(X);

AllT0Topologies(X);

NumberofT0Topologies(X);

K:={{a}};

GenerateTopologybySubBasis(X,K);

MinimalBasic(a,X,T);

MinimalBasis(X,T);

CloseUnions(T);

CloseIntersections(T);

CheckConnected(X,T);

AllConnectedSpaces(X);

NumberofConnectedSpaces(X);

ConnectedComponents(a,X,T);

AllConnectedComponentsTopology(X,T);

CheckTotalyDisconnected(X,T);

AllTotalyDisconnected(X);

NumberofTotalyDisconnectedSpaces(X);

AllDisconnectedSpaces(X);

NumberofDisconnectedSpaces(X);

CheckWeaklyDimensional(X,T);

AllWeaklyDimensionalSpaces(X);

NumberofWeaklyDimensionalSpaces(X);

GenerateExtremalTopology(a,c,        X);

AllExtremalTopologies(3);