Обсуждение @ 1067. Структура папок @ Timus Online Judge

CE? WY

Послано Oleg 26 дек 2002 19:39

type
folder = record
n:integer;
s:string[80];
a:array [1..500] of ^folder;
end;
pfolder= ^folder;

var i,j,k,n,m:integer;
    a:^folder;
    s,s1:string;

procedure add(a:pfolder;s:string);
var i,j,k:integer;
    s1,s2:string;
    b:^folder;
begin
if pos('\',s)>0 then
begin
s1:=copy(s,1,pos('\',s)-1);
delete(s,1,pos('\',s));
end else begin
s1:=s;
s:='';
end;
k:=0;
for i:=1 to a^.n do
if a^.a[i]^.s=s1 then
begin
   add(a^.a[i],s);
   k:=1;
end;
if k=0 then
begin
inc(a^.n);
getmem(a^.a[a^.n],sizeof(folder));
a^.a[a^.n]^.s:=s1;
a^.a[a^.n]^.n:=0;
if s<>'' then add(a^.a[a^.n],s);
end;
end;

procedure wr(a:pfolder;k:integer);
var i,j:integer;
begin
for i:=1 to k do write(' ');
if k>=0 then writeln(a^.s);
for i:=1 to a^.n do wr(a^.a[i],k+1);
end;

procedure deletes(a:pfolder);
var i,j:integer;
begin
for i:=1 to a^.n do deletes(a^.a[i]);
freemem(a,sizeof(folder));
end;

begin
getmem(a,sizeof(folder));
a^.s:=' ';
readln(n);
a^.n:=0;
for i:=1 to n do
begin
readln(s);
if pos('\',s)>0 then
begin
   s1:=copy(s,1,pos('\',s)-1);
   delete(s,1,pos('\',s));
end else begin
   s1:=s;
   s:='';
end;
k:=0;
for j:=1 to a^.n do
   if a^.a[j]^.s=s1 then
   begin
    if s<>'' then add(a^.a[j],s);
    k:=1;
   end;
if k=0 then
begin
   inc(a^.n);
   getmem(a^.a[a^.n],sizeof(folder));
   a^.a[a^.n]^.s:=s1;
   a^.a[a^.n]^.n:=0;
   if s<>'' then add(a^.a[a^.n],s);
end;
end;
wr(a,-1);
deletes(a);

new versoin.its Ce to. help

Послано Oleg 26 дек 2002 19:56

type
folder = record
n:integer;
s:string[80];
a:array [0..500] of ^folder;
end;
pfolder= ^folder;

var i,j,k,n,m:integer;
    a:^folder;
    s,s1:string;

procedure add(a:pfolder;s:string);
var i,j,k:integer;
    s1,s2:string;
    b:^folder;
begin
if pos('\',s)>0 then
begin
s1:=copy(s,1,pos('\',s)-1);
delete(s,1,pos('\',s));
end else begin
s1:=s;
s:='';
end;
k:=0;
for i:=1 to a^.n do
if a^.a[i]^.s=s1 then
begin
   add(a^.a[i],s);
   k:=1;
end;
if k=0 then
begin
inc(a^.n);
getmem(a^.a[a^.n],sizeof(folder));
a^.a[a^.n]^.s:=s1;
a^.a[a^.n]^.n:=0;
if s<>'' then add(a^.a[a^.n],s);
end;
end;

procedure wr(a:pfolder;k:integer);
var i,j:integer;
begin
for i:=1 to k do write(' ');
if k>=0 then writeln(a^.s);
for i:=1 to a^.n do wr(a^.a[i],k+1);
end;

procedure sort1(a:pfolder);
var i,j:integer;
begin
for i:=1 to a^.n do sort1(a^.a[i]);
for i:=1 to a^.n do
begin
for j:=i+1 to a^.n do
begin
   if a^.a[i]^.s>a^.a[j]^.s then
   begin
    a^.a[0]:=a^.a[i];
    a^.a[i]:=a^.a[j];
    a^.a[j]:=a^.a[0];
   end;
end;
end;
end;

procedure deletes(a:pfolder);
var i,j:integer;
begin
for i:=1 to a^.n do deletes(a^.a[i]);
freemem(a,sizeof(folder));
end;

begin
getmem(a,sizeof(folder));
a^.s:=' ';
readln(n);
a^.n:=0;
for i:=1 to n do
begin
readln(s);
if pos('\',s)>0 then
begin
   s1:=copy(s,1,pos('\',s)-1);
   delete(s,1,pos('\',s));
end else begin
   s1:=s;
   s:='';
end;
k:=0;
for j:=1 to a^.n do
   if a^.a[j]^.s=s1 then
   begin
    if s<>'' then add(a^.a[j],s);
    k:=1;
   end;
if k=0 then
begin
   inc(a^.n);
   getmem(a^.a[a^.n],sizeof(folder));
   a^.a[a^.n]^.s:=s1;
   a^.a[a^.n]^.n:=0;
   if s<>'' then add(a^.a[a^.n],s);
end;
end;
sort1(a);
wr(a,-1);
deletes(a);
end.

It's MLE (+)

Послано Dmitry 'Diman_YES' Kovalioff 27 дек 2002 12:58

{$APPTYPE CONSOLE}
type
pfolder= ^folder;
folder = record
n:integer;
s:string[80];
a:array [0..500] of pfolder;
end;

var i,j,k,n,m:integer;
    a:pfolder;
    s,s1:string;

procedure add(a:pfolder;s:string);
var i,j,k:integer;
    s1,s2:string;
    b:^folder;
begin
if pos('\',s)>0 then
begin
s1:=copy(s,1,pos('\',s)-1);
delete(s,1,pos('\',s));
end else begin
s1:=s;
s:='';
end;
k:=0;
for i:=1 to a^.n do
if a^.a[i]^.s=s1 then
begin
   add(a^.a[i],s);
   k:=1;
end;
if k=0 then
begin
inc(a^.n);
getmem(a^.a[a^.n],sizeof(folder));
a^.a[a^.n]^.s:=s1;
a^.a[a^.n]^.n:=0;
if s<>'' then add(a^.a[a^.n],s);
end;
end;

procedure wr(a:pfolder;k:integer);
var i,j:integer;
begin
for i:=1 to k do write(' ');
if k>=0 then writeln(a^.s);
for i:=1 to a^.n do wr(a^.a[i],k+1);
end;

procedure sort1(a:pfolder);
var i,j:integer;
begin
for i:=1 to a^.n do sort1(a^.a[i]);
for i:=1 to a^.n do
begin
for j:=i+1 to a^.n do
begin
   if a^.a[i]^.s>a^.a[j]^.s then
   begin
    a^.a[0]:=a^.a[i];
    a^.a[i]:=a^.a[j];
    a^.a[j]:=a^.a[0];
   end;
end;
end;
end;

procedure deletes(a:pfolder);
var i,j:integer;
begin
for i:=1 to a^.n do deletes(a^.a[i]);
freemem(a,sizeof(folder));
end;

begin
getmem(a,sizeof(folder));
a^.s:=' ';
readln(n);
a^.n:=0;
for i:=1 to n do
begin
readln(s);
if pos('\',s)>0 then
begin
   s1:=copy(s,1,pos('\',s)-1);
   delete(s,1,pos('\',s));
end else begin
   s1:=s;
   s:='';
end;
k:=0;
for j:=1 to a^.n do
   if a^.a[j]^.s=s1 then
   begin
    if s<>'' then add(a^.a[j],s);
    k:=1;
   end;
if k=0 then
begin
   inc(a^.n);
   getmem(a^.a[a^.n],sizeof(folder));
   a^.a[a^.n]^.s:=s1;
   a^.a[a^.n]^.n:=0;
   if s<>'' then add(a^.a[a^.n],s);
end;
end;
sort1(a);
wr(a,-1);
deletes(a);
end.

IMHO, this problem is rather simple, so I've solved it after 40 mins (-)

Послано Dmitry 'Diman_YES' Kovalioff 27 дек 2002 21:51

what does IMHO meen

Послано Oleg 28 дек 2002 07:15

Re: what does IMHO meen

Послано Cosine 3 авг 2003 09:14

> It means "in my humble opinion"

Обсуждение задачи 1067. Структура папок