1. Trang chủ
  2. » Công Nghệ Thông Tin

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

11 646 3

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 11
Dung lượng 42,25 KB

Các công cụ chuyển đổi và chỉnh sửa cho tài liệu này

Nội dung

Trang 1

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;

• {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

Trang 2

//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>

Trang 3

{ 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 ế ụ ụ ệ ậ ạ ọ ể

Trang 4

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

Trang 5

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;

Trang 6

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 thi th y ít cho i H C S đ ấ

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

Trang 7

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

Trang 8

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;

Trang 9

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>

Trang 10

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;

Trang 11

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;

Ngày đăng: 18/09/2016, 22:58

TỪ KHÓA LIÊN QUAN

w