Chương trình mẫu Free Pascal

PASCAL - Th ằ
ng h ạ
i não

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

Tổ
ng Quan - X ấ
u mà đẹp
•

•
•
•
•
•
•
•

Pascal không phân bi ệt hoa th ườ
n g. B ắt đầu định danh ph ải là Kí t ựch ữ, không cho phép kí
hi ệu trong địn h danh (tr ừ_ )
VD: BAI_NAY_MEO_BIET_LAM, bainayMeoBietLam, bai3eoThemLam
M ỗi câu l ệnh k ết thúc b ằng " ; ", kh ối l ệnh m ởđầu bang " begin " và k ế
t thúc bang "end"
C ấu trúc m ột ch ươ
n g trình Pascal chu ẩn
program Bai3MeoBietLam;
uses crt;
begin
{Méo biết trong này chứa gì}

end.
Mọi biến đều phải khai báo ở đầu chươ ng trình với từ khoá var hoặc const (đ/v hằng số)

C Ơ cmn B ẢN (nh ững gì tr ẻ trâu 8 h ọc)
Biến và Hằng
const SauChin = 69;
var SauChin, SinChau : integer = 69;
•
Khai báo hàm (sau var): <Định danh> : < kiểu > [< = <giá trị khởi tạo> ];
Giá trị khởi tạo có thể có hoặc không.
•
Khai báo hằng : const <định danh> = <giá trị>;
•
Các kiểu dữ cmn lieu: biết mấy thằng này là ngon rồi
Tên Kiểu | Phạm Vi
| Ý cmn Nghĩa
---------+-------------------------+-------------------BYTE
| 0..255
| Số tự nhiên
INTEGER | -32768..32767
| Số Nguyên
CHAR
| 256 Kí tự ASCII
| Kí tự đơn
STRING
| Max = 256 Char
| Chuỗi (Mảng kí tự)
BOOLEAN | TRUE/FALSE
| Luận lý
REAL

| 2,9x10^-39 .. 1,7x10^38 | Số Thực
LONGINT | -2147483648..2147483647 | Số Nguyên
CARDINAL |
0 .. 4294967295
| Số Tự Nhiên
INT64
|
-2^63 .. 2^63 - 1
| Số Nguyên


//Lưu ý: INT64 không thể dùng cho biến đếm for
•
Mảng: <định danh> : array [ < min > .. < max > ] of <kiểu>;

Toán Tử
:= gán (bác Wirth vui tính v**l)
+ - * / div (chia lấy nguyên) mod (chia lấy dư)
> < >= <= = <>(khác)
not or and

Điều Khiển
if <điều kiện> then <lệnh> [ else <lệnh (có thể if đc)> ] ;
case <biểu thức> of
<giá trị> : <lệnh> ;
[ else <lệnh>; ]
end;
for <biến đếm> := <đầu> to/downto <cuối> do <lệnh>
while <đk> do <lệnh>;
do <lệnh> while <đk>;

rapeat <lệnh> until <đk thoát>;

Thủ Tục Cơ bản
write ( 'Đây là chuỗi'); writeln ('Bla bla'); -> in ra không xuống dòng & xuống
dòng
read (<biến>); readln(<biến>); -> nhập input không cần enter và cần enter
sqr -> bình phương
sqrt -> căn bậc hai
abs -> lấy trị tuyệt đối
odd(x); xét x có là số lẻ ko
chr(x); -> trả về kí tự thứ x trong ascii
ord(x); -> trả về thứ tự của x trong ascii
round(x); -> làm tròn

CHUYÊN MÔN (nh ững gì th ằng đi thi h ọc)
Thủ Tục và Hàm
•

Thủ Tục:
procedure <tên> [ ([var] <tham số>: <kiểu tham số> ) ];
var <biến nội bộ> : <kiểu>;


begin
{ bla bla }
end;
•
Hàm: khi cần trả về trị, ta dùng exit(<trị>);
function <tên> [ ([var] <than số> : <kiểu tham số> ) ] : <kiểu trả về>;
var <biến nội bộ> : <kiểu>;

begin
{ bla bla }
end;

Thao Tác Tệp
assign(<filevar>, <địa chỉ file trên đĩa>); -> gán file
rewrite(<filevar>); -> tạo file mới để ghi
reset(<filevar>); -> đọc file
append(<filevar>); -> ghi file (file có sẵn)
close(<filevar>); -> đóng file
để đọc dữ liệu file ta dùng lệnh:
eof(<filevar>); -> file có kết thúc chưa
eoln(<filevar>); -> dòng đang đọc kết thúc chưa

Sâu
delete(<strvar>, <vị trí>, <độ dài>);
insert(<strvar>, <string>, <vị trí>);
copy(<strvar> , <vị trí>, <độ dài>);
length(<strvar>); -> trả về độ dài sâu (áp dung cho mảng cũng đc nhé ;) )
pos(<string>,<strvar>); -> trả về vị trí xuất hiện string đầu tiên trong strvar
upcase(<strvar>); / lowcase(<strvar>);
StrToInt(<string>); -> cast chuỗi thành số, cần dùng uses SysUtils;

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)while length(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)while length(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)while length(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;
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);

//return a^t


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')
if (c = 'b') or (c='B')
if (c = 'c') or (c='C')
if (c = 'd') or (c='D')
if (c = 'e') or (c='E')

if (c = 'f') or (c='F')
end;
n:= (x * mushroom(16,p)) + n;
inc(p);

then
then
then
then
then
then

x:=10;
x:=11;
x:=12;
x:=13;
x:=14;
x:=15;

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

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 lend;