Bài tập tin học

Bài 1

Code:

var f:text;
   s:array[1..100] of integer;
    i,td,n,j:integer;
begin
  assign(f,'bai1.inp');
  reset(f);
  readln(f,n);
  for i:=1 to n do readln(f,s[i]);
  close(f);
  for i:=1 to n-1 do
  for j:=i+1 to n do
  if s[j] < s[i] then
  begin
  td:=s[i];
  s[i]:=s[j];
  s[j]:=td;
  end;
  assign(f,'bai1.out');
  rewrite(f);
  for i:=1 to n do
  writeln(f,s[i]);
  close(f);
end.

Bài 2[b]

Code:

var s:string[30];
   i:integer;
    f:text;
    ho,dem,ten:string;
procedure lamsach(var s:string);
begin
   while pos(' ',s) = 1 do delete(s,pos(' ',s),1);
    while pos(' ',s) = length(s) do delete(s,length(s),1);
    while pos('  ',s) <> 0 do delete(s,pos('  ',s),1);
end;
begin
   assign(f,'bai2.inp');
       reset(f);
    read(f,s);
       close(f);
    lamsach(s);
    ho:= '';
    for i:=1 to length(s) do
    if s[i] = ' ' then break
       else ho:=ho+s[i];
    ten:= '';
    for i:=length(s) downto 1 do
    if s[i] = ' ' then break
       else ten:=s[i]+ten;
    dem:=copy(s,length(ho) + 2,length(s) - length(ho) - length(ten) - 2);
    assign(f,'bai2.out');
       rewrite(f);
    writeln(f,ho);
    writeln(f,dem);
    write(f,ten);
       close(f);
end.

Bài 3

Code:

var f:text;
   a,s:array[1..100] of integer;
    i,j,n,td,k:integer;
begin
  assign(f,'bai3.inp');
  reset(f);
  readln(f,n);
  while not eof(f) do
  for i:=1 to n do read(f,s[i]);
  close(f);
  k:=0;
  for i:=1 to n do
  if s[i] mod 2 <> 0 then
    begin
    inc(k);
    a[k]:=s[i];
    end;
  for i:=1 to k-1 do
  for j:=i+1 to k do
    if a[j] > a[i] then
     begin
      td:=a[i];
      a[i]:=a[j];
      a[j]:=td;
      end;
  assign(f,'bai3.out');
  rewrite(f);
  if k >1 then     
    write(f,a[1],' ',a[2])
  else write(f,-1);
  close(f);
end.

Bài 4

Code:

var s:array[1..1000] of integer;
   n,i:integer;
    f1,f2 : text;
begin
   assign(f1,'bai4.inp');
    reset(f1);
    readln(f1,n);
    for i:=1 to n do read(f1,s[i]);
    close(f1);
    assign(f2,'bai4.out');
    rewrite(f2);
   for i:=1 to n do
       if s[i] mod 2 <> 0 then
           begin
            write(f2,s[i]);
            if i = n then break
            else write(f2,' ');
            end;
    writeln(f2);
    for i:=1 to n do
       if s[i] mod 2 = 0 then
           begin
            write(f2,s[i]);
            if i = n then break
            else write(f2,' ');
            end;
    close(f2);

end.

Bài 5

Code:

var s:string;
   f:text;
   
procedure lamsach(var s:string);
  begin
    while pos(' ',s) = 1 do delete(s,pos(' ',s),1);
    while pos(' ',s) = length(s) do delete(s,pos(' ',s),1);
    while pos('  ',s) <> 0 do delete(s,pos('  ',s),1);
  end;
begin
assign(f,'bai5.inp');
reset(f);
read(f,s);
close(f);
lamsach(s);
s:=s+ ' ';
assign(f,'bai5.out');
rewrite(f);
while pos(' ',s) <> 0 do
  begin
  writeln(f,copy(s,1,pos(' ',s)));
  delete(s,1,pos(' ',s));
  end;
close(f);
end.