Buổi 3-4. Ngôn ngữ lập trình cơ bản (08 bài)

program nfind;
var
        m,i : longint;
        c : array[1..100000]of longint;
        k : longint;
procedure phantich ( u : longint);
var
        i : longint;
begin
        i := 2; k := 0;
        while i*i <= u do
                if u mod i = 0 then
                begin
                        inc(k);
                        c[k]:= i ;
                        u :=u div i ;
                end
        else
                inc(i);
                if u > i then
                        begin
                                inc(k);
                                c[k] := u;
                        end;
end;
begin
        readln(m);
        phantich(m);
        for i := 1 to k do
                if c[i] <> c[i+1] then
                        write(c[i], #32);
end.

program numberc;
var
        n : longint;
        c:array [1..100000] of longint;
function snt( u : longint ): boolean;
var j : longint;
begin
        if u <= 1 then exit(false);
        if ( u = 2 ) or ( u = 3 ) then exit(true);
        for j := 2 to trunc(sqrt(u)) do
                if ( u mod j = 0 ) then exit(false);
        exit(true);
end;

begin
        readln(n);
        while ( snt(n) = false) and (n > 0 ) do
        begin
                n := n div 10;
                if n > 0 then writeln(n)
                else writeln('-1');
        end;
end.

program tsnt;
var n,i,k:longint;
    c:array[1..1000000]of longint;
procedure phantich(u:longint);
var i:longint;
begin
        k:=0;
        i:=2;
        while i*i<=u do
        if u mod i=0 then
        begin
                k:=k+1;
                c[k]:=i;
                u:=u div i;
        end
        else i:=i+1;
        if u>1 then
                begin
                        k:=k+1;
                        c[k]:=u;
                end;
        end;
        begin
                readln(n);
                phantich(n);
                for i:=1 to k do
                write(c[i],#32);
        end.

program arrdel;
var
        n,i,k : longint;
        a,c : array [1..100000] of longint;
begin
        readln(n);
        for i := 1 to n do readln(a[i]);
        k := 0;
        for i := 1 to n do
                if a[i] = a[i+1] then
                        begin
                                inc(k);
                                c[k] := a[i];
                        end;
        for i := 1 to k do write(c[i], #32)
end.

program nfind;
var m,k,i:longint;
c:array[1..100000]of longint;
procedure phantich(u:longint);
var i:longint;
begin
        i:=2;
        k:=0;
        while i*i<=u do
        if u mod i=0 then
        begin
        k:=k+1;
        c[k]:=i;
        u:=u div i;
        end
        else
        i:=i+1;
        if u>i then
        begin
                k:=k+1;
                c[k]:=u;
        end;
end;
begin
        readln(m);
        phantich(m);
        for i:= 1 to k do
        if c[i]<>c[i+1] then
        write(c[i],#32);
end.

program numberc;
var n:longint;
c:array[1..10000000]of longint;
function ngto(u:longint):boolean;
var i:longint;
begin
        if u<=1 then
        exit(false);
        if (u=2) or (u=3) then
        exit(true);
        for i:=2 to trunc(sqrt(u)) do
        if (u mod i=0) then
        exit(false);
        exit(true);
end;
begin
        readln(n);
        while (ngto(n)=false)and(n>0) do
        begin
                n:=n div 10;
                if n>0 then
                begin
                        if n>0 then write(n)
                        else write('-1');
                end;
        end;
end.

program arrdel;
var n,i,k:longint;
a,c:array[1..1000000]of longint;
begin
        readln(n);
        for i:=1 to n do
        readln(a[i]);
        k:=0;
        for i:=1 to n do
        if a[i]=a[i+1] then
                begin
                        k:=k+1;
                        c[k] := a[i];
                end;
        for i:=1 to k do
        write(c[i],#32);
end.

const fi='tsnt.inp';
      fo='tsnt.out';
var k,n,i:longint;
    c:array [0..100] of longint;
procedure ptn(n:longint);
var i:longint;
begin
i:=2;
while i<=n do
if n mod i=0 then
begin
inc(k);
c[k]:=i;
n:=n div i;
end else inc(i);
if n>1 then begin inc(k); c[k]:=n end;
end;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
ptn(n);
for i:=1 to k do write(c[i],#32);
close(input);
close(output);
end.

const fi='numberc.inp';
      fo='numberc.out';
var n,s:longint;
function nt(n:longint):boolean;
var i:longint;
begin
if n<=1 then exit(false);
if (n<=3) and (n>1) then exit(true);
for i:=2 to trunc(sqrt(n)) do
if n mod i =0 then exit(false);
exit(true);
end;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
n:=n div 10;
while n>0 do
begin
if nt(n) then s:=n;
n:=n div 10;
end;
if s<>0 then write(s) else write(-1);
close(input);
close(output);
end.

const fi='arrdel.inp';
      fo='arrdel.out';
var  i,n:longint;
    a:array [0..1000] of longint;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
for i:=1 to n do
if a[i]<>a[i+1] then write(a[i],#32);
close(input);
close(output);
end.

Var n: longint;
Function TachSo(i: longint): longint;
Begin
        I:=2;
        While n>1 do
        Begin
                If n mod i = 0 then
                        Begin
                                Write(i,#32);
                                N:= n div i
                        End
                Else i:=i+1;
        End;
End;
Begin
        Assign(Input,'TSNT.INP');
        Assign(Output,'TSNT.OUT');
        Reset(Input);
        Rewrite(Output);
        Readln(n);
        Write(TachSo(n));
        Close(Input);
        Close(Output);
End.

Var a:array[0..10000]of longint;
    n,k,c:longint;
Procedure sort(l,r: longint);
Var i,j,x,y: longint;
Begin
        I:=l;
        J:=r;
        X:=a[(l+r) div 2];
        Repeat
                While a[i]<x do
                        Inc(i);
                                While x<a[j] do
                                        Dec(j);
                                        If not(i>j) then
                                                Begin
                                                        Y:=a[i];
                                                        A[i]:=a[j];
                                                        A[j]:=y;
                                                        Inc(i);
                                                        J:=j-1;
                                                End;
        Until i>j;
        If l<j then Sort(l,j);
        If i<r then Sort(i,r);
End;
Begin
        Assign(Input,'QSORT.INP');
        Assign(Output,'QSORT.OUT');
        Reset(Input);
        Rewrite(Output);
        Readln(n);
        C:=n;
        For k:=1 to n do read(a[k]);
        Sort(1,n);
        For k:=1 to c do write(a[k],' ');
        Close(Input);
        Close(Output);
End.

Var n,i: longint;
    a: array[-7..100007] of longint;
Procedure BBS();
Var tam,i,j: longint;
Begin
        For i:=1 to n-1 do
                For j:=i+1 to n do
                        If a[i] > a[j] then
                                Begin
                                        tam:=a[i];
                                        a[i]:=a[j];
                                        a[j]:=tam;
                                End;
        For i:=1 to n do write(a[i],#32);
End;
Begin
        Assign(Input,'BUBBLESORT.INP');
        Assign(Output,'BUBLESORT.OUT');
        Reset(Input);
        Rewrite(Output);
        Readln(n);
        For i:=1 to n do read(a[i]);
        BBS();
        Close(Input);
        Close(Output);
End.

program  qsort;
var
   i, n: Longint;
   a : array[1..10000000] of Longint;
procedure sapsep (u: Longint);
var
      i, j, tam : Longint;
begin
   for  i := 1 to n-1 do
      for j := i+1 to n do
         if a[i] > a[j] then
            begin
               tam := a[i];
               a[i] := a[j];
               a[j] := tam;       
            end;
         for i := 1 to n do write(a[i]);     
end;   
begin
   readln(n);
   for i := 1 to n do readln(a[i]);
   sapsep(a[i]);
end.

program qsort;
var n,i:longint;
a:array[1..1000000]of longint;
procedure sapxep();
var i,j,tam:longint;
begin
        for i:=1 to n-1 do
        for j:=i+1 to n do
        if a[i]>a[j] then
        begin
                tam:=a[i];
                a[i]:=a[j];
                a[j]:=tam;
        end;
        for i:=1 to n do write(a[i],#32);
end;
begin
readln(n);
for i:=1 to n do
readln(a[i]);
sapxep();
readln;
end.

const fi='qsort.inp';
      fo='qsort.out';
var n,i:longint;
    a:array [0..1000] of longint;
procedure qsort(l,r:longint);
var i,j,tg,chot,giua:longint;
begin
i:=l;
j:=r;
giua:=(i+j) div 2;
chot:=a[giua];
while i<=j do
begin
while a[i]<chot do inc(i);
while a[j]>chot do dec(j);
if i<=j then
begin
tg:=a[i]; a[i]:=a[j]; a[j]:=tg;
inc(i); dec(j);
end; end;
if i<r then qsort(i,r);
if l<j then qsort(l,j);
end;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
qsort(1,n);
for i:=1 to n do write(a[i],#32);
close(input);
close(output);
end.

program sap_xep_nhanh;
var
 n ,i : Longint;
 a : array[1..1000000] of Longint;
procedure qsort(l,r :Longint);
var
 i, j, t, chot, giua: Longint;
begin
 i := l;
 j := r;
 giua := (i + j) div 2;
 chot := a[giua];
 while i <= j do
 begin
 while a[i] < chot do inc(i);
 while a[j] > chot do dec(j);
 if i <= j then
 begin
 t := a[i];
 a[i] := a[j];
 a[j] := l ;
 inc(i);
 dec(j);
 end;
 
 end;
end;
begin
 readln(n);
 for i := 1 to n do read(a[i]);
 qsort(1,n);
 for i := 1 to n do write(a[i]);  
end.

program sap_xep_nhanh;
var n,i:longint;
a:array[1..10000000] of longint;
procedure qsort(l,r:Longint);
var i,j,t,chot,giua:longint;
begin
  i:=l;
  j:=r;
  giua:=(i+j) div 2;
  chot:=a[giua];
  while i<=j do
      begin
        while a[i]<chot do inc(i);
        while a[j]>chot do dec(j);
        if i<=j then
            begin
              t:=a[i];
              a[i]:=a[j];
              a[j]:=l ;
              inc(i);
              dec(j);
            end;
        for i:=1 to n do write(a[i]);
      end;
end;
begin
  readln(n);
  for i:=1 to n do read(a[i]);
  qsort(i,n);
end.

const fi='ilucky.inp';
      fo='ilucky.out';
var n,i,l,r,k:longint;
    a:array [0..1000] of longint;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
for i:=1 to n do r:=r+a[i];
for i:=0 to n do
begin
if l=r then
begin
write(i,#32);
k:=1;
end;
l:=l+a[i+1];
r:=r-a[i+1];
end;
if k=0 then write(-1);
close(input);
close(output);
end.

uses math;
const fi='pmin.inp';
      fo='pmin.out';
var i,n,res:longint;
    a:array [0..1000] of longint;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
res:=high(longint);
for i:=1 to n do
begin
read(a[i]);
res:=min(res,a[i]);
end;
for i:=1 to n do
if res=a[i] then write(i,#32);
close(input);
close(output);
end.

uses math;
const fi='psecond.inp';
      fo='psecond.out';
var i,res,res2,n:longint;
    a:array [0..1000] of longint;
begin
assign(input,fi); reset(input);
assign(output,fo); rewrite(output);
readln(n);
res:=high(longint);
res2:=high(longint);
for i:=1 to n do
begin
read(a[i]);
res:=min(res,a[i]);
end;
for i:=1 to n do
if a[i]>res then res2:=min(res2,a[i]);
if res2=high(longint) then write(-1)
else for i:=1 to n do if res2=a[i] then write(i,#32);
close(input);
close(output);
end.

var x1,y1,x2,y2,x3,y3,x4,y4,x5,y5: longint;
a,b,d1,d2,d3,d4,p1,p2,p3,p4,s1,s2,s3,s4: real;
begin
readln(x1,y1,x2,y2,x3,y3,x4,y4,x5,y5);
a:=sqrt(sqr(x4-x1)+sqr(y4-y1));
b:=sqrt(sqr(x2-x1)+sqr(y2-y1));
d1:=sqrt(sqr(x5-x1)+sqr(y5-y1));
d2:=sqrt(sqr(x5-x4)+sqr(y5-y4));
d3:=sqrt(sqr(x5-x2)+sqr(y5-y2));
d4:=sqrt(sqr(x5-x3)+sqr(y5-y3));
p1:=(d1+d3+b)/2;
s1:=sqrt(p1*(p1-d1)*(p1-d3)*(p1-b));
p2:=(d1+d2+a)/2;
s2:=sqrt(p2*(p2-d1)*(p2-d2)*(p2-a));
p3:=(d2+d4+b)/2;
s3:=sqrt(p3*(p3-d2)*(p3-d4)*(p3-b));
p4:=(d3+d4+a)/2;
s4:=sqrt(p4*(p4-d3)*(p4-d4)*(p4-a));
write(s1:0:2,#32,s2:0:2,#32,s3:0:2,#32,s4:0:2);
end.