#PASCAL - Thằng hại não part 2 
Bài viết phục vụ cho việc ôn tập Pascal nhanh chóng cho các bạn thi tin học các kiểu 
Lưu ý: các giải thuật nào cần thuộc lòng thì tác giả sẽ viết luôn mã, còn hên xui thì mã giả
Các Giải Thuật Cơ Bản
Kiểm tra nguyên tố
function isPrime (n: longint): boolean;
var g: longint;
begin
if n=1 then exit(false) else for g:=2 to trunc(sqrt(n)) do
if n mod g = 0 then exit(false);
exit(true);
end;
Ước chung lớn nhất
function uc(a,b: longint):longint;
var t: longint;
begin
while b>0 do begin
a:= a mod b; t:=a; a:=b; b:=t; //get mod and swap
end;
exit(a);
end;
Bội chung nhỏ nhất
function bc(a,b: longint):longint;
begin
exit( (a*b) div uc(a,b) );
end;
Số fibonacci
function fib(n: longint):longint;
begin
if n<=1 then exit(n) else exit( fib(n-1) + fib(n-2) );
end;
Xử Lý Số Nguyên Lớn
type int69 = string; //bigger than int64 :V
So sánh
function ss(a,b: int69): integer;
begin
while length(a)<length(B) do a:='0'+a;
while length(b)<length(a) do b:='0'+b;
if a=b then exit(0) else if a>b then exit(1) else exit(-1);
end;
Cộng
function sum(a,b: int69): int69;
var s,i,cr,x,y: integer;
c: int69;
begin
while length(a)<length(B) do a:='0'+a;
while length(b)<length(a) do b:='0'+b;
cr:=0; c:='';
for i:= length(A) downto 1 do begin
s:= ord(a[i])-48 + ord(b[i])-48 + cr;
cr:= sum div 10; c:=chr(s mod 10 + 48)+c;
end;
if cr>0 then c:='1'+c;
exit(c);
end;
Trừ
function sub(a,b: int69): int69;
var c: int69;
s,b,i: integer;
begin
b:=0; c:='';
while length(a)<length(B) do a:='0'+a;
while length(b)<length(a) do b:='0'+b;
for i:= length(a) downto 1 do begin
s:= ord(a[i])-ord(b[i])-b;
if s<0 then begin s:=s+10; b:=1; end else b:=0;
c:= chr(s+48)+c;
end;
while (length(C)>1) and (c[1]='0') do delete(c,1,1); //take Sunsilk, smoother
end;
Nhân
function mul(a,b: int69): int69;
var s,t: int69;
m,i,j:integer;
begin
m:=-1; s:='';
for i:= length(a) downto 1 do begin
inc(m); t:=''; for j:= 1 to ord(a[i])-48 do t:=sum(t,b);
for j:= 1 to m do t:=t+'0'; s:=add(t,s);
end;
exit(s);
end;
Chia
function divi(a,b: int69): int69;
var c, h: int69;
kb: array[0..10] of int69;
i,k: longint;
begin
kb[0]:='0'; for i:= 1 to 10 do kb[i]:=add(kb[i-1],b);
h:=''; c:='';
for i:= 1 to length(A) do begin
inc(h,a[i]); k:=1;
while ss(h,kb[k])<>-1 do inc(k);
c:=c+chr(k-1+48); h:= sub(h,kb[k-1]);
end;
while (length(c)>1) and (c[1]='0') do delete(c,1,1);
exit(c);
end;
Modula
function divi(a,b: int69): int69;
var h: int69;
kb: array[0..10] of int69;
i,k: longint;
begin
kb[0]:='0'; for i:= 1 to 10 do kb[i]:=add(kb[i-1],b);
h:='';
for i:= 1 to length(A) do begin
inc(h,a[i]); k:=1;
while ss(h,kb[k])<>-1 do inc(k);
c:=c+chr(k-1+48); h:= sub(h,kb[k-1]);
end;
exit(h);
end;
Chuyển Đổi Hệ Cơ Số đi thi thấy ít cho
function mushroom(a,t: integer): longint; //return a^t
var i: byte;
n: longint;
begin
if t = 0 then exit(1);
n:= a;
for i:= 1 to t-1 do begin
n:=n*a;
end;
exit(n);
end;
function rvs(a: string): string;
var i: integer;
p: string='';
begin
for i:= length(a) downto 1 do p := p+a[i];
exit(p);
end;
function Bin_Dec(a: string): longint;
var n,p,i: integer;
begin
p:=0; n:=0;
for i:= length(a) downto 1 do begin
n:= (strtoint(a[i]) * mushroom(2,p)) + n;
inc(p);
end;
exit(n);
end;
function Dec_Bin(a: integer): string;
var i,k: integer;
p: string = '';
begin
k:= a div 2;
p:= p+inttostr(a mod 2);
while k <> 0 do begin
p:=p+inttostr(k mod 2);
k:= k div 2;
end;
exit(rvs(p));
end;
function Hex_Dec(a: string): longint;
var p,i,x: integer;
c: char;
n: longint;
begin
p:=0; n:=0;
for i:= length(a) downto 1 do begin
c:= a[i];
if c in ['0'..'9'] then begin
x:=strtoint(c);
end else begin
if (c = 'a') or (c='A') then x:=10;
if (c = 'b') or (c='B') then x:=11;
if (c = 'c') or (c='C') then x:=12;
if (c = 'd') or (c='D') then x:=13;
if (c = 'e') or (c='E') then x:=14;
if (c = 'f') or (c='F') then x:=15;
end;
n:= (x * mushroom(16,p)) + n;
inc(p);
end;
exit(n);
end;
function Dec_Hex(a: integer): string;
var i,k: integer;
p: string = '';
x: byte;
m: string;
begin
k:= a div 16;
p:= p+inttostr(a mod 16);
while k >= 0 do begin
x:=k mod 16;
if x < 10 then p:= p+inttostr(x) else begin
if x = 10 then p:=p+'A';
if x = 11 then p:=p+'B';
if x = 12 then p:=p+'C';
if x = 13 then p:=p+'D';
if x = 14 then p:=p+'E';
if x = 15 then p:=p+'F';
end;
k:= k div 16;
end;
exit(rvs(p));
end;
function Hex_Bin(s: string): string;
var i: integer;
a: string;
p: integer= 1;
r: string='';
m: string='';
begin
a:=s;
for i:= 1 to length(a) do begin //make each Hexa character to 4 Binary characters and append them into a string
m:= Dec_Bin(Hex_Dec(a[i]));
while length(m) < 4 do m:='0'+m;
r:=r+m;
end;
exit(r);
end;
function Bin_Hex(s: string): string;
var HexStr: string = '';
step: integer = 4;
position: integer = 1;
a: string;
i: integer = 1;
t: string;
begin
t:= s;
while (length(t) mod 4) <> 0 do t:='0'+t;
while position < length(t) do begin //divide all group of bin and convert it to Hex and append into a string
a:= Dec_Hex(Bin_Dec(copy(t,position,step)));
HexStr := HexStr + a;
inc(i); position:= position + step;
end;
while HexStr[1] = '0' do delete(HexStr,1,1);
exit(HexStr);
end;
##Các Phương Pháp Giải Bài Toán Liệt Kê hoặc liên quan Đệ Qui
Generating (Sinh)
//Xây dựng cấu hình đang có
repeat
//đưa ra cấu hình đang có
//sinh cấu hình mới từ cấu tình đã có
until //hết cấu hình ;
Quay Lui Vét Cạn
procedure backtrack(i);
begin
for <mọi giá trị có thể gán cho x[i]> do begin
<thử cho x[i]:= V>
if <x[i] là pt cuối trong ch> then <xuất cấu hình>
else begin
<ghi nhận việc gán V>
backtrack(i+1);
<bỏ ghi nhận để thử giá trị khác>
end;
end;
end;
Nhánh Cận
procedure nc(i);
begin
for <mọi giá trị có thể gán cho x[i]> do begin
<thử cho x[i]:= V>
if <có cấu hình tốt hơn> then
if <x[i] là pt cuối trong ch> then <xuất cấu hình>
else begin
<ghi nhận việc gán V>
backtrack(i+1);
<bỏ ghi nhận để thử giá trị khác>
end;
end;
end;
Tham lam
Lưu ý:đây là phương pháp bất đắc dĩ hoặc cho kịp thời gian vì nó không đưa ra nghiệm tối ưu hoàn toàn.Nó chỉ đúng ở 1 số bộ test nhất định
procedure greedy;
begin
//khởi tạo Vector nghiệm
i:=0;
while <chưa hết nghiệm> do begin
inc(i);
//xây dựng S[i]
X = select(S[i]) //chọn ứng viên sáng giá
end;
end;
Chia để trị
procedure CdT(a,x) //tìm nghiệm x của A
begin
if <A đủ nhỏ> then <giải A>
else begin
//chia bài toán
for i:= 1 to m do cdt(A[i], x[i])
//ghép các nghiệm để nhận nghiệm cuối
end;
end;
##Sắp Xếp
Đi thị thì xài 2 cái là đủ rồi
Bubble
for i:= 1 to n-1 do for j:= n downto i+1 do if a[j-1] > a[j] then swap(a[j-1], a[j]);
Quick
procedure sort(l,r: longint);
var i,j,p: longint;
begin
i:=l; j:=r; p:=(l+r) div 2;
repeat
while a[i] < a[p] do inc(i); while a[j] > a[p] do dec(j);
if i<=j then begin swap(a[j],a[i]); inc(i); dec(j); end;
until i>j;
if l<j then sort(l,j); if i<r then sort(i,r);
end;
Vẫn đang tiếp tục cập nhật…
83% thành viên diễn đàn không hỏi bài tập, còn bạn thì sao?