Program Boeken(input,output); const maxboeken=30; (* maximum hoeveelheid boeken op een plank *) maxlen=20; (* maximum lengte van een titel *) (* De naam kast ten spijt, gaat het hier niet om de kasten in de opgave, maar ja, de naam plankstruct is zo mogelijk nog waardelozer *) type kastp=^kast; kast = record prefix: string[maxlen+1]; (* gebruikte prefix in de boom *) grootste: string[maxlen+1]; (* prefix van alle boeken op deze plank *) boeken: integer; boek:array[1..maxboeken] of string[maxlen+1]; (* De titels op deze plank *) child,next:kastp; echt:boolean; end; var planken: integer; plank: kastp; plankenperkast,boekenperplank: integer; tab: integer; runs,r: integer; boeken,b: integer; titel: string[maxlen+1]; Function StrNCmp(var a,b:string; n:integer):integer; var result,i:integer; begin result:=0; i:=1; while (result=0) and (i<=n) do begin if (i>StrLen(a)) or (i>StrLen(b)) then begin result:=StrLen(a)-StrLen(b); end else begin result:=Ord(a[i])-Ord(b[i]); end; i:=i+1; end; StrNCmp:=result; end; { StrNCmp } Procedure StrNCpy(var a,b:string; n:integer); var i:integer; begin a:=b; (* Waarom mag ik geen a[i]:=b[i] doen van HP-Pascal? *) SetStrLen(a,n); end; { StrNCpy } Function StrEqual(var a,b:string):integer; (* Returns the length of the common prefix of strings a and b *) var len,result,i:integer; begin len:=StrLen(a); if (StrLen(b)<len) then len:=StrLen(b); result:=0; i:=1; while (i<=len) do begin if (a[i]=b[i]) and (result=i-1) then result:=i; i:=i+1; end; StrEqual:=result; end; { StrEqual } Procedure Init(pl:kastp;var titel:string); begin pl^.prefix:=''; (* prefix in deze ``boom'' is leeg *) pl^.grootste:=titel; (* prefix op deze plank is de titel *) pl^.boeken:=1; pl^.boek[1]:=titel; (* Dit boek STAAT op de plank *) pl^.child:=NIL; pl^.next:=NIL; pl^.echt:=true; planken:=planken+1; end; { Init } Procedure Print(pl:kastp); var i,j:integer; begin if (pl<>NIL) then begin (* for i:=1 to 3*tab do Write(' '); WriteLn('prefix: `',pl^.prefix,''' grootste: `',pl^.grootste,''''); for j:=1 to pl^.boeken do begin for i:=1 to 3*tab do Write(' '); WriteLn(pl^.boek[j]); end; tab:=tab+3; Print(pl^.child); tab:=tab-3; Print(pl^.next); *) end; end; { Print } Procedure Quit(var pl:kastp); begin if (pl<>NIL) then begin Quit(pl^.child); Quit(pl^.next); Dispose(pl); pl:=NIL; end; end; { Quit } Function Zoek(pl:kastp;var titel:string):kastp; var plch,pln:kastp; magtienog:boolean; begin (* Neem aan dat er tenminste 1 kind is *) plch:=pl^.child; if (StrNCmp(plch^.prefix,titel,StrLen(plch^.prefix))>0) then begin Zoek:=NIL; end else begin pln:=plch^.next; magtienog:=(pln<>NIL); if magtienog then magtienog:=StrNCmp(pln^.prefix,titel,StrLen(pln^.prefix))<=0; while magtienog do begin plch:=pln; pln:=pln^.next; magtienog:=(pln<>NIL); if magtienog then magtienog:=StrNCmp(pln^.prefix,titel,StrLen(pln^.prefix))<=0; end; Zoek:=plch; end; end; { Zoek } Procedure Herverdeel(pl:kastp); var i,j:integer; nwpl,zpl:kastp; begin pl^.prefix:=pl^.grootste; pl^.grootste:=''; pl^.echt:=false; (* Voor elk boek op deze plank moet een kind-plank gevonden worden *) for i:=1 to pl^.boeken do begin zpl:=Zoek(pl,pl^.boek[i]); if (zpl=NIL) then begin New(nwpl); Init(nwpl,pl^.boek[i]); j:=StrEqual(pl^.prefix,pl^.boek[i]); StrNCpy(nwpl^.prefix,pl^.boek[i],j+1); nwpl^.next:=pl^.child; pl^.child:=nwpl; end else begin if (StrNCmp(zpl^.prefix,pl^.boek[i],StrLen(zpl^.prefix))<0) then begin New(nwpl); Init(nwpl,pl^.boek[i]); j:=StrEqual(pl^.prefix,pl^.boek[i]); StrNCpy(nwpl^.prefix,pl^.boek[i],j+1); nwpl^.next:=zpl^.next; zpl^.next:=nwpl; end else begin (* Het boek hoort op deze plank thuis *) zpl^.boeken:=zpl^.boeken+1; zpl^.boek[zpl^.boeken]:=pl^.boek[i]; j:=StrEqual(zpl^.grootste,pl^.boek[i]); SetStrLen(zpl^.grootste,j); end; end; Print(pl); end; pl^.boeken:=0; planken:=planken-1; (* pl is nu geen ``echte'' plank meer *) end; { Herverdeel } Procedure VolgendeBoek(var titel:string); var pl,nwpl,zpl:kastp; i:integer; quit:boolean; begin quit:=false; if (plank=NIL) then begin New(plank); Init(plank,titel); end else begin pl:=plank; while not pl^.echt do begin (* oftewel, er ZIJN kinderen *) zpl:=Zoek(pl,titel); if (zpl=NIL) then begin (* Maak nieuwe plank vooraan in lijst van kinderen *) New(nwpl); Init(nwpl,titel); i:=StrEqual(pl^.child^.prefix,titel); StrNCpy(nwpl^.prefix,titel,i+1); nwpl^.next:=pl^.child; pl^.child:=nwpl; quit:=true; end else begin if (StrNCmp(zpl^.prefix,titel,StrLen(zpl^.prefix))<0) then begin New(nwpl); Init(nwpl,titel); i:=StrEqual(pl^.prefix,titel); StrNCpy(nwpl^.prefix,titel,i+1); nwpl^.next:=zpl^.next; zpl^.next:=nwpl; quit:=true; end else begin pl:=zpl; end; end; end; if not quit then begin (* We zijn nu aangekomen bij een ``echte'' plank. Het boek moet hierbij *) i:=StrEqual(pl^.grootste,titel); SetStrLen(pl^.grootste,i); if (pl^.boeken<boekenperplank) then begin (* boeken hoeven niet gesorteerd op de plank te staan *) pl^.boeken:=pl^.boeken+1; pl^.boek[pl^.boeken]:=titel; end else begin (* Leg de nieuwe titel vast op zijn eigen plank, * zodat Zoek gebruikt mag worden *) New(nwpl); Init(nwpl,titel); StrNCpy(nwpl^.prefix,titel,StrLen(pl^.grootste)+1); pl^.child:=nwpl; Herverdeel(pl); end; end; end; end; { VolgendeBoek } begin ReadLn(runs); for r:=1 to runs do begin tab:=0; planken:=0; plank:=NIL; ReadLn(plankenperkast,boekenperplank,boeken); for b:=1 to boeken do begin ReadLn(titel); VolgendeBoek(titel); Print(plank); end; WriteLn((planken+plankenperkast-1) div plankenperkast:1); Quit(plank); end; end.