Giao An On ThiHSG 12
Giao An On ThiHSG 12
GV: Vo Th Lieu
BAI TAP C BAN - ap an ++ 1. Viet chng trnh tnh iem trung bnh 3 mon Toan, Ly , Hoa theo he so 2,1,1 sau o xep loai nh sau: a. Loai Gioi : TB >= 8.0 va khong co mon nao di 6,5 b. Loai Kha : 6.5=<TB < 8.0 va khong co mon nao di 5 c. Loai Trung bnh : 5.0 =<TB < 6.5 va khong co mon nao di 3.5 d. Loai Yeu : Con lai.
program xep_loai_hoc_sinh; uses crt; var t,l,h,tbc, min:real; xl:string; begin write('moi nhap diem toan,ly,hoa: '); readln(t,l,h); min:=l; if min>t then min:=t; if min>h then min:=h; tbc:=(t*2+l+h)/4; if (tbc>=8) and (min>=6.5) then xl:='Gioi'; else if (tbc>=6.5) and (min>=5) then xl:=Kha; else if (tbc>=5) and (min>=3.5) then xl:='Trung binh' else xl:='yeu'; writeln(Diem trung binh:,tbc:0:1, Xep loai:,xl); readln;
end.
2. VCT nhap vao thang, nam va cho biet thang o co bao nhieu ngay?
var n,t,ngay:integer; begin write('nhap thang:');readln(t); write('nhap nam:');readln(n); case t of 1,3,5,7,8,10,12: ngay:=31; 4,6,9,11:ngay:=30; 2: if n mod 4 = 0 then ngay :=29 else ngay:=28; end; writeln('Thang:',t,' nam:',n,' co: ',ngay,' ngay'); readln; end.
3. VCT tm c chung ln nhat va boi chung nho nhat cua hai so nhap vao t ban phm? var a,b,min,max,ucln:integer; begin write('moi nhap hai so can xac dinh: ');readln(a,b); max:=a; min:=b; if max mod min=0 then ucln:=min else if min mod max=0 then ucln:=max else begin repeat if max>min then max:=max-min else if max<min then min:=min-max; until max=min; ucln:=min; end; write('ucln ',ucln); write('bcnn ',a*b/ucln:1:1); readln; end. 4. VCT giai hai bai toan co: 100 trau 100 bo co va va ga va cho 36 con 100 chan?
GV: Vo Th Lieu
var d,n,g:integer; begin for d:=1 to 20 do for n:=1 to 33 do for g:=1 to 98 do if d*5+n*3+g=100 then writeln('Trau dung:',d,' trau nam:',n,' trau gia:',g); readln; end. ----var i,j:integer; begin for i:=1 to 25 do for j:=1 to 50 do if (i*4+j*2=100) and (i+j=36) then writeln(i,' con cho, ',j,' con ga.'); readln; end. var j,n,m,i:integer; function ktranto(x:integer):boolean; begin ktranto:=true; for i:=2 to x -1 do if x mod i=0 then ktranto:=false; end; begin write('moi nhap n,m: '); readln(n,m); for j:=n to m do if ktranto(j) then writeln(j); readln; end. var x,tu,j,i,n,m:integer; function ktrahhao(x:integer):boolean; begin tu:=0; ktrahhao:=false; for i:=1 to x div 2 do if x mod i=0 then tu:=i+tu; if tu=x then ktrahhao:=true; end; begin write('moi nhap n,m: ');readln(n,m); for j:=n to m do if ktrahhao(j) then writeln(j); readln; end.
7. VCT tao mot mang so nguyen gom n phan t nho hn 1000. Sap xep mang theo t t tang dan va giam dan.
const n=10; var i,j,tam:integer; a:array[1..n]of integer; begin randomize; for i:=1 to n do a[i]:=random(1000); 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 writeln(a[i]);
GV: Vo Th Lieu
end.
readln;
8. VCT oc mot so co 3 ch so nhap vao t ban phm? uses crt; Var s:array[1..9] of string; a,b,c,n:integer; begin clrscr; repeat write('nhap so nguyen n:');readln(n); until (n>99)and(n<1000); a:=n div 100; b:=n div 10 mod 10 ; c:=n mod 10; s[1]:='mot'; s[2]:='hai'; s[3]: ='ba'; s[4]:='bon'; s[5]:='nam'; s[6]: ='sau'; s[7]:='bay'; s[8]:='tam'; s[9]:='chin'; if (b=0)and(c=0) then write(s[a],'tram'); if (b=0)and(c<>0)then write(s[a],'tram linh',s[c]); if (b<>0)and (c=0)then write(s[a],'tram',s[b],'muoi'); if (b<>0)and(c=5)then write(s[a],'tram',s[b],'lam'); if (b<>0)and(c<>0)and(c<>5)then write(s[a],'tram',s[b],'muoi',s[c]); readln; end. 9. VCT sa danh t rieng b nhap sai. (VD: TraN QuANG kHai Tran Quang Khai) uses crt; var s:string; i:integer; begin write('nhap mot danh tu rieng:');readln(s); while s[1]=#32 do delete(s,1,1); while s[length(s)]=#32 do delete(s,length(s),1); while pos(#32#32,s)<>0 do delete(s,pos(#32#32,s),1); for i:=1 to length(s) do if (s[i]>=' A')AND(s[i]<='Z')then s[i]:=chr(ord(s[i])+32) ; s[1]:=upcase(s[1]); for i:=1 to length(s) do if s[i]=#32then s[i+1]:=upcase (s[i+1]); write('danh tu duoc sua lai la:',s); readln; end. 10. VCT in ngc cac t cua mot xau, moi t in ra tren mot dong va xuat ra so ky t cua moi t? ( vd: Tran Quang Khai Khai : 4 ky t Quang : 5 ky t Tran : 4 ky t uses crt; var s,s1,s2,t:string; a:array[1..100] of string; b:array[1..100] of integer; i,j,k:integer; begin
GV: Vo Th Lieu
clrscr; write(' Nhap xau s:');readln(s); s:=s+' '; for i:= 1 to length(s) do if s[i]<>#32 then t:=t+s[i] else begin inc(j); a[j]:=t; t:=''; end; for i:=1 to j do b[i]:=length(a[i]); for k:=i downto 1 do writeln(a[k]:20,' readln; end.
:',b[k]:4,' ky tu');
11. VCT tach mot xau S ra thanh 4 xau: S1: cha cac ch cai in HOA, S2:
uses crt; var hoa,thuong,so:set of char; s,s1,s2,s3,s4:string; i:integer ; begin clrscr; write('nhap xau s:');readln(s); hoa:=['A'..'Z']; thuong:=['a'..'z']; so:=['0'..'9']; for i:=1 to length(s) do if s[i] in hoa then s1:=s1+s[i] else if s[i] in thuong then s2:=s2+s[i] else if s[i] in so then s3:=s3+s[i] else s4:=s4+s[i]; writeln(s1:6); writeln(s2:6); writeln(s3:6); writeln(s4:6); readln; end.
cha cac ch cai thng; S3 cha cac so 09; S4 cha cac ky t khac( :;><?/!@#$%^&*...)
12. VCT lam thay oi chc nang phm CAPLOCK, khi tat caplock ta go ch cai th xuat hien ch cai hoa, ngc lai khi bat en caplock ta go ch cai th xuat hien ch cai thng.. uses crt; var hoa,thuong:string; ch,t,h:char; Begin clrscr; for t:='a'to'z'do thuong:=thuong+t; for h:='A'to'Z'do hoa:=hoa+h; repeat ch:=readkey; if pos(ch,thuong)<>0 then ch:=upcase(ch) else if pos(ch,hoa)<>0 then ch:=chr(ord(ch)+32); write(ch); until ch=#13; end. 13. VCT nhap cac k t t ban phm khong cho hien ky t nay len ma ch hien cac dau * nh kieu mat khau. Hoi co hien mat khau khong neu co th xuat mat khau va nhap ra. uses crt; var s:string;
GV: Vo Th Lieu
ch,tl:char; Begin clrscr; write('Nhap mat khau:'); repeat ch:=readkey; write('*'); s:=s+ch; until ch=#13; writeln; write('Co hien mat khau khong(c/k):');readln(tl); if upcase(tl)='C' then write(' Mat khau la:',s); readln; end. 14. VCT oi mot so <4000 ra so La Ma ( L :50; C:100; D:500; M:1000 - vd:2364 MMCCDLXIV) var a,x,y,w,z:integer; n: array [0..3] of string; t: array [0..9] of string; c: array [0..9] of string; d: array [0..9] of string; begin n[1]:='C';n[2]:='CC';n[3]:='CCC'; t[1]:='M';t[2]:='MM';t[3]:='MMM';t[4]:='MD'; t[5]:='D';t[6]:='DM';t[7]:='DMM';t[8]:='DMMM';t[9]:='MC'; c[1]:='X';c[2]:='XX';c[3]:='XXX';c[4]:='XL'; c[5]:='L';c[6]:='LX';c[7]:='LXX';c[8]:='LXXX';c[1]:='XM'; d[1]:='I';d[2]:='II';d[3]:='III';d[4]:='IV'; d[5]:='V';d[6]:='VI';d[7]:='VII';d[8]:='VIII';d[1]:='IX'; {I$-} repeat write('moi nhap so: '); readln(a); until (a<4000) and (IOResult=0); {I$+} x:=a div 1000; y:=a mod 1000 div 100; w:=a mod 100 div 10; z:=a mod 10; write(n[x],t[y],c[w],d[z]); readln; end. 15. Viet chng trnh ieu chnh mot so nguyen b nhap sai t ban phm. Sau o se cho biet so nhap sai va so a sa neu ngi s dung yeu cau. V du: so nhap sai la: 23hdj43jj, chng trnh se sa lai la:2343 var s,s1:string; i,j:integer; so:set of char; tloi:char; begin readln(s); so:=['0'..'9']; for i :=1 to length(s) do if s[i]in so then s1:=s1+s[i]; write('Co hien so khong (c/k)');readln(tloi); if upcase(tloi)<>'C' then write('Tam biet') else if length(s1)<length(s)then write('Ban nhap so sai: ',s,' sua lai la: ',s1) else write('Ban nhap so chinh xac:',s);readln; end.
GV: Vo Th Lieu
16. Nhap mot xau s bao gom so va k t, in ra xau a sap xep so theo th t tang dan con v tr cac k t van gi nguyen? V du: nhap: abc6ghj7kkkkk1hhhh9 Ket qua: abc1ghj6kkkkk7hhhh9 var a:array[1..100]of integer; s,s1,s2:string; i,X,c,tam,j,n:integer; so : SET OF integer; Begin so:=['0'..'9']; readln(s); for i:=1 to length(s) do if (s[i] in so) then begin val(s[i],x,c); j:=j+1; a[j]:=x end; for i:=1 to j-1 do for n:=i+1 to j do if a[i]>a[n] then begin tam:=a[i]; a[i]:=a[n]; a[n]:=tam; end; for i:=1 to j do begin str(a[i],s1); s2:=s2+s1; end; n:=0;s1:=''; for i:=1 to length(s) do if s[i] in so then begin inc(n); delete(s,i,1); insert(s2[n],s,i); end; write(s); readln; end. 17. VCT cho nhap mot xau ky t trong o co lan vao mot so co 3 ch so (vd: fffhgj234fgg)- co kiem tra viec nhap sai (vd: jghjg45jk hoac ggdg012gdg hoac ggdgg34hjhh3) va cho phep nhap lai. Kiem tra cho biet so o co phai la so nguyen to khong? var s,s1:string; x,vt,c,dem,i:integer; function ktranto(a:integer):boolean; begin ktranto:=true; for i:=2 to a-1 do if a mod i=0 then ktranto:=false; end; begin repeat dem:=0; write('moi nhap xau: '); readln(s); for i:=1 to length(s) do if s[i] in ['0'..'9'] then
GV: Vo Th Lieu
end. 18. VCT kiem tra viec nhap mot ky t va mot xau ky t bang k t in hoa( neu khong ung th nhap lai) sau o cho biet so lan ky t xuat hien trong xau ky t?
uses crt; var i,dem:integer; ch:char; s:string; begin clrscr; repeat write('moi nhap ki tu: '); readln(ch); until ch in ['A'..'Z']; repeat write('moi nhap xau ki tu: '); readln(s); dem:=0; for i:=1 to length(s) do if s[i] in ['A'..'Z'] then inc(dem); until dem=length(s); dem:=0; for i:=1 to length(s) do if ch=s[I] then inc(dem); write(ch,' xuat hien ',dem, ' trong ', s); readln; end.
dem:=dem+1; if dem=1 then vt:=i; s1:=copy(s,vt,3); val(s1,x,c); end; until (c=0) and (x>99) and (dem=3); if ktranto(x) then write('day la so nguyen to :',x); readln;
begin
19. VCT nhap vao mot 2 xau S va s1 in ra cac ly t chung cua hai xau? var s,s1,s2:string; i:integer; begin write('moi nhap sau thu nhat: '); readln(s); write('moi nhap sau thu hai: '); readln(s1); i:=1; repeat s2:=copy(s,i+1,length(s)); if pos(s[i],s2)<>0 then delete(s,i,1) else inc(i); until pos(s[i],s2)=0; for i:=1 to length(s) do if pos(s[i],s1)<>0 then writeln('ki ',s[i],' xuat hien trong ca hai sau'); readln; end. 20. VCT ve cac hnh: a. Ch nhat ac. c. Tam giac can ac. e. Tam giac vuong b. Ch nhat rong. d. Tam giac can rong. ac. f. Tam giac vuong rong. (Hnh ch nhat: nhap chieu dai va chieu rong, Tam giac: nhap chieu cao; ve cac hnh tren vi ky t nhap t ban phm; co the lam thanh 6 bai rieng biet hoac lam chung mot chng trnh co la chon )
GV: Vo Th Lieu
uses crt; {BAI TOAN VE CAC LOAI HINH VOI KICH THUOC VA KI TU NHAP TU BAN PHIM} var c,h,n,d,r,luachon:integer; ch:char; begin clrscr; writeln(' Ve hinh chu nhat dac, nhap:1'); writeln(' Ve hinh chu nhat rong, nhap:2'); writeln(' Ve tam giac can dac, nhap:3'); writeln(' Ve tam giac can rong, nhap:4'); writeln(' Ve tam giac vuong dac, nhap:5'); writeln(' Ve tam giac vuong rong, nhap:6'); writeln; repeat Write('Moi nhap so:'); readln(luachon); until (0<luachon)and(luachon<7); write('Nhap ky tu de ve hinh:');readln(ch); case luachon of 1: BEGIN write('nhap chieu dai hinh chu nhat dac:');readln(d); write('nhap chieu rong hinh chu nhat dac:');readln(r); clrscr; for c:=1 to d do begin for h:=1 to r do write(ch); writeln; end; END; 2: BEGIN write('nhap chieu dai hinh chu nhat rong:');readln(d); write('nhap chieu rong hinh chu nhat rong:');readln(r); clrscr; for c:=1 to d do begin for h:=1 to r do if (c=1)or(h=1)or(c=d)or(h=r) then write(ch) else write(' '); writeln; end; END; 3: BEGIN write('Nhap chieu cao tam giac can dac:');readln(n); clrscr; for c:=1 to n do begin for h:=n-c+1 to n+c-1 do begin gotoxy(h,c);write(ch);end; writeln; end; END; 4:BEGIN write('Nhap chieu cao tam giac can rong:');readln(n); clrscr; for h:=1 to n do begin for c:=1 to 2*n-1 do if (c=n-h+1) or (c=n+h-1)or(h=n) then write(ch) else write(' '); writeln; end; END; 5:BEGIN write('Nhap chieu cao tam giac vuong dac:');readln(n); clrscr; for h:=1 to n do begin for c:=1 to h do write(ch); writeln;
GV: Vo Th Lieu
end; END; 6:BEGIN write('Nhap chieu cao tam giac vuong rong:');readln(n); clrscr; for h:=1 to n do begin for c:=1 to h do if (c=1)or(h=n)or(c=h)then write(ch) else write(' '); writeln; end; END; END;{KET THUC LENH CASE} readln; end.
GV: Vo Th Lieu
n tp
Em hy lp trnh bng ngn ng Pascal gii cc bi ton sau: Bi I (10 im): DIN TCH CC HNH. Cho hnh ch nht ABCD c chiu di AB l a (cm), chiu rng AD l b (cm) vi a, b l cc s nguyn dng khng vt qu 10000. Mt im M trn on BC, mt im N trn on CD sao cho di (tnh bng cm) cc on BM, CN bng nhau v l s nguyn khng m. B A M
Yu cu: C D N 1. Bit di BM, tnh din tch hnh ch nht ABCD v din tch tam gic MCN. 2.Tm gi tr ln nht v gi tr nh nht ca din tch tam gic AMN khi M, N thay i. D liu vo: D liu ca bi ton cho trong tp tin DIENTICH.INP gm ba s a, b, x (x b a, x l di BM trong yu cu 1) c ghi trn cng mt dng theo ng th t trn, hai s lin tip cch nhau mt khong trng. D liu ra: Kt qu ghi ra mn hnh (hoc ghi ra file DIENTICH.OUT) trn 5 dng: - Dng u l ba s a, b v x. - Dng th hai l din tch hnh ch nht ABCD. - Dng th ba l din tch tam gic MCN - Dng th t l gi tr ln nht ca din tch tam gic AMN - Dng th nm l gi tr nh nht ca din tch tam gic AMN (Cc gi tr din tch c ghi trong dng thp phn vi 1 ch s sau du phy). V d: DIENTICH.INP Kt qu trn mn hnh (hoc file DIENTICH.OUT) 10 6 2 10 6 2 60.0 4.0 30.0 17.5 Hn ch k thut: - Ghi tn file bi lm l DIENTICH.PAS. - D liu vo l chnh xc khng cn kim tra. - Nu khng nhp c d liu vo t file, th sinh c th nhp d liu vo t bn phm - C khong 60% s b test c a < 100. Bi II(10 im): DY S. Cho s nguyn dng S v dy s gm N s nguyn dng F1, F2, ..., FN. Dy s cho c gi l dy tng dn nu: Fi Fi+1 {1,2,..., n 1} ( hay F1 F2 F3 ... FN ). i Chng ta gi hai s hng Fi1 v Fi2 trong dy cho (vi i1 i2; i1,i2 {1,2,..., n} ): - L mt cp i xung khc nu Fi1 + Fi2 = S. - L mt cp i l tng nu chng cng c ba ch s, cc ch s ca s hng ny ging ht ca s hng kia nhng khc v th t xut hin - v d 123 v 132 hay 121 v 211 l cc cp i l tng cn 121 v 122 hay 457 v 457 th khng phi. Yu cu: Cho bit S v dy s F1, F2, ..., FN. Hy xc nh xem dy cho c phi dy tng dn hay khng, tnh s cp i xung khc v tm mt cp i l tng (nu c) trong dy cho. D liu vo: D liu vo ca bi ton c cho trong tp tin DAYSO.INP vi cu trc nh sau: - Dng u tin gm hai s N v S (N 50000, S <1000). - Dng th i trong N dng tip theo cha mt s l s Fi ca dy (Fi < 500). D liu ra: Kt qu ghi ra trn mn hnh (hoc ghi ra file DAYSO.OUT)bn dng: - Dng u ghi ba s N, S v FN. 10
GV: Vo Th Lieu
- Dng th hai ghi CO nu dy cho l dy tng dn, ghi KHONG nu ngc li. - Dng th ba ghi mt s l s cp i xung khc trong dy cho. - Dng th t ghi hai s l mt cp i l tng tm c trong dy cho, nu khng c cp i l tng no th ghi hai s 0. V d: DAYSO.INP Kt qu trn mn hnh (hoc file DAYSO.OUT) 55 555 1 CO 2 2 3 00 4 5 10 111 10 111 101 110 KHONG 110 7 1 110 101 1 5 5 10 10 10 101 Hn ch k thut: - Ghi tn file bi lm l DAYSO.PAS - D liu vo l chnh xc khng cn kim tra. - C khong 30% s b test c th nhp d liu vo t bn phm. - C khong 60% s b test c N < 1000. ------------- Ht-------------
11
GV: Vo Th Lieu
p n
I- D liu chm bi. Gim kho copy 14 file d liu vo gm: - 7 file test bi 1 ln lt l DIENTICH.IN1, DIENTICH.IN2, , DIENTICH.IN7, - 7 file test bi 2 ln lt l DAYSO.IN1, DAYSO.IN2, , DAYSO.IN7 vo th mc cha Turbo Pascal trn my chm bi. II Chm bi. Vi mi bi thi ca 1 th sinh: Chm bi 1: 1. Gim kho Copy bi lm c tn DIENTICH.PAS vo th mc cha Turbo Pascal trn my chm bi. 2. Vi mi file d liu vo - nu hc sinh khng nhp d liu t file th gim kho nhp t bn phm - chy chng trnh ca hc sinh ri quan st kt qu trn mn hnh (hoc trn file d liu ra) so snh vi p n v cho im chi tit nh sau: + Ba test u, mi test 2 im: - Ghi ra ng a, b, x cho 0,25 im - Ghi ra ng din tch hnh ch nht ABCD cho 0,25 im - Ghi ra ng din tch tam gic MCN cho 0,50 im - Ghi ra ng din tch nh nht cho 0,50 im - Ghi ra ng din tch ln nht cho 0,50 im + Bn test sau, mi test 1 im: (Khng cho im ghi ng a, b, x na) - Ghi ra ng din tch hnh ch nht ABCD cho 0,25 im - Ghi ra ng din tch tam gic MCN cho 0,25 im - Ghi ra ng din tch nh nht cho 0,25 im - Ghi ra ng din tch ln nht cho 0,25 im Chm bi 2: 1. Gim kho Copy bi lm c tn DAYSO.PAS vo th mc cha Turbo Pascal trn my chm bi. 2. Vi mi file d liu vo - nu hc sinh khng nhp d liu t file th gim kho nhp t bn phm 2 test u tin - chy chng trnh ca hc sinh ri quan st kt qu trn mn hnh so snh vi p n v cho im chi tit nh sau: + Ba test u, mi test 2 im: - Ghi ra ng N, S, FN cho 0,25 im - Ghi ra ng dy tng dn hay khng cho 0,75 im - Ghi ra ng s cp xung khc cho 0,75 im - Ghi ra ng cp i l tng cho 0,25 im + Bn test sau, mi test 1 im: (Khng cho im ghi ra ng N, S, FN na). - Ghi ra ng dy tng dn hay khng cho 0, 25 im - Ghi ra ng s cp xung khc cho 0,50 im - Ghi ra ng cp i l tng cho 0,25 im
{Bi 1 - DIENTICH.PAS} var a,b,x:integer; min, max,s,s1,s2:real; f: text; begin Assign(f,'dt.inp'); reset(f); 12
GV: Vo Th Lieu
readln(f,a,b,x); close(f); writeln(a, ,b, ,x); s1:=a*b; s2:=x*(b-x)/2; min:=s1/2; max:=s1/2; for x:=1 to b do begin s:=s1 - (a*x + x*(b-x) + b*(a-x))/2; if min>s then min:=s; if max<s then max:=s; end; writeln(s1:12:1);writeln(s2:12:1); writeln(max:12:1);writeln(min:12:1); readln; end. Bi 2 - DAYSO.PAS} uses crt; const fi = 'dayso.inp'; max = 500; var a:array[1..500] of word; so:array[1..4,0..9,0..9] of boolean; f:text; tangdan:boolean; n,s,fn,socu:word; Tongxk:longint; procedure nhap; var i,k:word; begin fillchar(a,sizeof(a),0); assign(f,fi); reset(f); socu:=0; tangdan:=true; readln(f,n,s); for i:= 1 to n do begin readln(f,k); inc(a[k]); if k<socu then tangdan:=false; socu:=k; if k>100 then so[k div 100,(k div 10)mod 10,k mod 10]:=true; end; fn:=k; close(f); end; procedure demxungkhac; var i:word; begin tongxk:=0; for i:= 1 to ((s-1)div 2) do tongxk:=tongxk+a[i]*a[s-i]; if not odd(s) then begin i:=s div 2; 13
GV: Vo Th Lieu
tongxk:=tongxk+(a[i]*(a[i]-1) div 2); end; end; procedure timlytuong; var i,j,k:byte; begin for i:=1 to 4 do for j:=0 to 9 do for k:=0 to 0 do if so[i,j,k] then begin if (j<>k)and so[i,k,j] then begin write(i,j,k,' ',i,k,j); exit; end; if (k<>0)and(i<>k)and so[k,j,i] then begin write(i,j,k,' ',k,j,i); exit; end; if (j<>0)and(i<>j)and so[j,i,k] then begin write(i,j,k,' ',j,i,k); exit; end; if (k<>0)and((i<>j)or(i<>k)or(k<>j))and so[k,i,j] then begin write(i,j,k,' ',k,i,j); exit; end; if (j<>0)and((i<>j)or(i<>k)or(k<>j))and so[j,k,i] then begin write(i,j,k,' ',k,j,i); exit; end; end; writeln(0,' ',0); end; procedure inkq; begin clrscr; writeln(n,' ',s,' ',fn); if tangdan then writeln('CO') else writeln('KHONG'); demxungkhac; writeln(tongxk); timlytuong; end; begin nhap; inkq; readln; end.
14
GV: Vo Th Lieu
Cch t kho th 1:
2 5
Cch t kho th Yu cu: - Nhp d liu vo t bn phm s lng ht kim cng th t cc ht xu vo chui ht. - Tm v tr c th t kho tho mn yu cu trn. Cu 3. Trong h trc to Oxy cho N ng trn bng nhau c cc tm O1, O2,, ON , bn knh R. H ng trn trn c gi l chun nu nu cc ng trn trn i mt khng chng ln nhau(hai ng trn c th tip xc nhau) Vit chng trnh kim tra h ng trn c chun hay khng? D liu: cho trong File INP.DAT + Dng 1: ghi s N l s lng ng trn v bn knh R. + N dng tip theo mi dng ghi hai s nguyn xi v yi l to ca Oi D liu l cc s nguyn, cc s nghi trn cng mt dng cch nhau t nht 1 du cch. V d: - INP.DAT Kt qu: - INP.DAT Kt qu: 53 H ng trn 4 10 H khng chun chun: 00 00 11 06 10 10 10 20 -9 7 -8 3 -2 -10 -----------------------------------15
GV: Vo Th Lieu
p n
Cu 1. 6 Khai bo cc bin hp l, t chc c d liu t tp ng, song kt qu cn sai : 1 c tp SN.DAT a ra cc s nguyn t trn mn hnh v ghi vo tp NT.DAT : 2,5 c tp SN.DAT a ra cc s hon ho trn mn hnh v ghi vo tp HH.DAT : 2,5 Cu 2. 7 Khai bo cc bin hp l, nhp c d liu t bn phm, song kt qu cn sai : 2 Ch ra c cc v tr t kho : 5 Cu 3. 7 Khai bo cc bin hp l, t chc c d liu t tp ng, song kt qu cn sai : 2 Thut ton bng NNLT Pascal th hin thut ton cho kt qu ng : 5 Li gi c th cho cc bi ton nh sau: (Cc bi ton c vit trn NNLT Pascal) Bi 1: Program bai1; Uses Crt; Var A,b,c: Array[1..100] of integer; N,i,j ,M,t,tong,k,l : Integer; f1,f,f2: text; Begin clrscr; Assign(f,'C:\sn.dat'); reset(f); Readln(f,N,M); i:=0; {$I+}; if IOresult <>0 then halt; for i:=1 to N do Begin for j:=1 to M do read(f,a[(i-1)*N+j]); readln(f); End; close(f); Assign(f1,'C:\HH.dat'); rewrite(f1); t:=0; WRITELN('KET QUA DOC TEP:'); For i:=1 to N do Begin for j:=1 to M do Begin tong:=0; write(A[(i-1)*N+j]:3); for k:=1 to A[(i-1)*N+j]-1 do if A[(i-1)*N+j] mod k =0 then tong:=tong+k; if tong=A[(i-1)*N+j] then 16
GV: Vo Th Lieu
begin t:=t+1; c[t]:=A[(i-1)*N+j] ; write(f1,c[t]:5); if t mod 10 =0 then writeln(f1); end; end; writeln; End; Writeln('CAC SO HOAN HAO LA'); Assign(f2,'C:\NT.dat'); rewrite(f2); for i:=1 to t do begin Write(c[i]:3); if i mod 10 = 0 then writeln; end; l:=0; For i:=1 to N do Begin for j:=1 to M do if abs(A[(i-1)*N+j])>1 then Begin t:=2; k:= TRUNc(SQRT(A[(i-1)*N+j])); While (A[(i-1)*N+j] mod t<>0)and (t<=k) do t:=t+1; if t>k then begin l:=l+1; B[l]:=A[(i-1)*N+j] ; write(f2,B[l]:2); if l mod 10 =0 then writeln(f2); end; end; End; Writeln('CAC SO NGUYEN TO LA:'); for i:=1 to L do begin write(b[i]:3); if i mod 10 = 0 then writeln; end; close(f1); close(f2); Readln End. Bi 2. Program cau2; Uses crt; Var A:array[1..50] of string; ct:array[1..9]of byte; i,j,n:byte; s,p:string[120]; h:string[240]; Begin clrscr; 17
GV: Vo Th Lieu
write('So vien da quy: '); readln(n); write('So chi thi mau: '); readln(s); h:=s+s; for i:=1 to 2*n do begin a[i]:=copy(h,i,n); h:=s+s; end; writeln('cac vi tri co then lap:'); for j:=1 to 2*n do begin p:=''; for i:=n downto 1 do p:=p+a[j][i]; if p=a[j] then writeln('giua ',j-1,' va ',j); end; readln end. Bi 3. Program bai_3; Uses Crt; Var n: Byte; R,i,j : Integer; C: Array[1..2,1..100] of integer; Procedure nhap; Var f: text; Begin Assign(f, INP.Dat); Reset(f); Readln(f,n,R); Fillchar(C,sizeOf(C),0); For i:=1 to N do Readln(f, C[1,i], C[2,i]); Close(f); End; Funtion Kiemtra: Boolean; Begin Clrscr; Kiemtra:=false; If sqr(C[1,i] C[2,i]) + sqr(C[1,i] C[2,j])<4*R*R then exit; Kiemtra:=true; End; Begin Nhap; IF kiemtra then Writeln(He duong tron chuan) Else Writeln(He duong tron khong chuan); Readln; End. -------------------------------------------------------------------------------------------------------------------
18
GV: Vo Th Lieu
Bi tp
BI TON CHUYN I C S: Nhp c s vo, s vo v c s ra, i s vo c s vo thnh s ra c s ra? c kim tra d liu khi nhp v cho php nhp li. C s vo v c s ra c th nhn gi tr t 2 n 36. V d 1: c s vo : 16 s vo: 1f c s ra: 2 s ra : 11111 v d 2: c s vo : 8 s vo: 149 --> d liu sai v cho php nhp li. HNG DN GII: 1. Chuyn s vo (sv) c s vo (csv) thnh s tp c s 10. 2. Chuyn s tp c s 10 thnh s ra (sr) c s ra (scr). CHNG TRNH CHI TIT: uses crt; const chuso:string='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; var sv,sr:string; csv,csr,du,i,k:0..36; tp:longint; kt:boolean; begin repeat clrscr; write('Nhap co so vao:');readln(csv); write('Nhap so vao:');readln(sv); for i:=1 to length(sv) do sv[i]:=upcase(sv[i]); kt:=true; for i:=1 to length(sv) do if pos(sv[i],chuso)-1>=csv then kt:=false; until (2<=csv)and(csv<=36)and kt; repeat write('Nhap co so ra:');readln(csr); until (2<=csr)and(csr<=36); {doi sang co so 10} tp:=0; for i:=1 to length(sv) do begin k:=pos(sv[i],chuso)-1; tp:=tp*csv+k; end; {doi sang co so ra} sr:=''; while tp >0 do begin du:=tp mod csr; sr:=chuso[du+1]+sr; tp:=tp div csr; end; writeln('Doi sang co so ',csr,':',sr); readln; end. 19
GV: Vo Th Lieu
20
GV: Vo Th Lieu
p n:
const fi='mole.inp'; fo='mole.out'; max_mole=10000; vocuc=maxlongint; type maxxy=-10000..10000; xytype= record x,y:maxxy; end; molexy=array[1..max_mole] of xytype; var n,minpos:0..max_mole; t: molexy; minxy:xytype; step:longint; {2 im} {-------------------------------} procedure readdata(filename:string); var f:text; i:integer; begin assign(f,filename); reset(f);readln(f,n); for i:=1 to n do readln(f,t[i].x,t[i].y); close(f); ` end; {3 im} {-------------------------------} procedure swap (var a,b:xytype); var tmp:xytype; begin tmp:=a; a:=b;b:=tmp; end; {2 im} {------------------------------} procedure qsorty(var t:molexy; lo,hi:integer); var i,j,mid:integer; begin i:=lo;j:=hi;mid:=t[(lo+hi)div 2].y; repeat while t[i].y> mid do inc(i); while t[j].y <mid do dec(j); if i<=j then begin swap(t[i],t[j]); inc(i); dec(j); end; until i>j; if lo< j then qsorty(t,lo,j); if hi>i then qsorty(t,i,hi); end; {4 im} {-------------------------------------------} procedure qsortx(var t:molexy; lo,hi:integer); var i,j,mid:integer; begin i:=lo;j:=hi;mid:=t[(lo+hi)div 2].x; 21
GV: Vo Th Lieu
repeat while t[i].x> mid do inc(i); while t[j].y >mid do dec(j); if i<=j then begin swap(t[i],t[j]); inc(i); dec(j); end; until i>j; if lo< j then qsortx(t,lo,j); if hi>i then qsorty(t,i,hi); end; {4 im} {-----------------------------------------} procedure findminxy(var minxy:xytype); var i:0..max_mole; begin qsorty(t,1,n); minxy.y:=t[(n+1)div 2].y; qsortx(t,1,n); for i:=0 to n-1 do dec(t[i+1].x,i); qsortx(t,1,n); minxy.x:=t[(n+1)div 2].x; end; procedure solve; var i:1..max_mole; begin findminxy(minxy); for i:=1 to n do inc(step, abs(t[i].x-minxy.x )+abs(t[i].y-minxy.y)); end; {3 im} {-----------------------------} procedure output; var f: text; begin assign(f,fo); rewrite(f); write(f,step); close(f); end; BEGIN readdata(fi); solve; output; END. {2 im}
22
GV: Vo Th Lieu
thi th:
Bi ton 1 : Di chuyn t Ty sang ng trn li vung. Pht biu: Cho hnh ch nht A gm m x n vung, mi cha mt s nguyn. C th di chuyn t mt sang thuc ct bn phi cng dng hoc chnh lch mt dng. Tm cch di chuyn t mt no thuc ct 1 n mt no thuc ct n sao cho tng cc s ca cc i qua l nh nht. D liu vo: C th cho file Input.bt1. Trong hng u tin ch 2 s m v n, m hng tip theo, mi hng cha n cha s ca ma trn trng s. Bi ton 2 : Tm xu chung cc i. Cho 2 xu bt k, vit chng trnh in ra tt c cc xu chung v cui cng thng bo xu chung cc i ca hai xu cho. D liu vo: C th cho file Input.bt2. Trong dng th nht cha xu th nht, dng th 2 cha xu th 2.
23
GV: Vo Th Lieu
p n:
Bi 1: (5 im), trong : Phn tch bi ton: - Gi P(r, s) l bi ton di chuyn t Ty sang ng, vi: r N*: S dng ca hnh ch nht. s N*: s ct ca hnh ch nht. - Bi ton ban u l P(p, n)) - Cc gi tr cn tm: F[r,s]: gi tr Nh nht ca cc s trn cc i qua ca bi ton P(r, s) Gii php quy: - Khi s = 1: F[r, 1] = A[r,1] - Khi s > 1: F[r, s] = min { F[r-1,s-1],F[r,s-1],F[r+1,s-1]} +A[r,s] a) Th tc c d liu: 1im b) Th tc lp bng: 2 im Procedure Lapbang; Var i,j,d: byte; Begin For j:=0 to n do A[0,j]:=Maxint; For j:=0 to n do A[m+1,j]:=Maxint; Fillchar(t,siseof(t),0); For j:=2 to n do For i:=1 to m do Begin d:=min(i,j); A[i,j]:=A[d,j-1]+A[i,j]; T[I,j]:=d; End; End; c) Th tc Tng hp kt qu: 2 im Procedure Ketqua; Var i,j,d: byte; p:integer; Begin p:=maxint; For i:=1 to m do If a[i,n]<p then Begin d:=i; p:=a[i,n] End; i:=n; i:=d; kq[j]:=d; while j>0 do Begin i:= t[i,j]; j:=j-1; 24
GV: Vo Th Lieu
kq[j]:=i; End; End; Bi 2: (5 im), trong : a) Th tc oc d liu: 1 im. b) Th tc tm xu chung: 3 im. c) Th tc Thng bo kt qu: 1 im. program Xau_chung_cuc_dai; uses crt, Strings; var T1, T2, T : string; i, l1, l2 : byte; {-------Chuong trinh con-----------} {---------Thu tuc khoi tao---------} procedure Init(var T1, T2 : String; var l1, l2 : byte); begin Write(' Nhap xau T1 : '); Readln(T1); l1:=length(T1); Writeln; Write(' Nhap xau T2 : '); Readln(T2); l2:=length(T2); end; {---------Thu tuc Hien thi---------} procedure Show_result(T : String); begin Writeln; Writeln(' Xau chung cuc dai la : ', T); end; {-----Ham tra ve xau lon hon trong 2 xau------} function Max(S1, S2 : String) : String; begin if (length(S1) > length(S2)) then Max:=S1 else Max:=S2; end; {----- Ham tim xau chung cuc dai---} function Xau_chung(i : byte) : String; var S : String; k, bg, mem : byte; begin if (i < 1) then Xau_chung:='' else begin {Tim xau chung S cua hai xau T2 va xau con cua T1 bat dau tai vi tri i} 25
GV: Vo Th Lieu
S:=''; mem:=1; for k:=i to l1 do begin bg:=mem; while (bg <= l2) do begin if (T1[k] = T2[bg]) then begin S:=S + T2[bg]; mem:=bg+1; break; end; inc(bg); end; end; Writeln(' Xau_chung(',i,') co xau chung la : ',S); Xau_chung:= Max(S,Xau_chung(i-1)); end; end; {----------------------------------} begin clrscr; Init(T1,T2,l1,l2); T:=Xau_chung(l1); Show_result(T); readln; end.
26
GV: Vo Th Lieu
Bi tp
BI 1 : BI TON DIN TCH TAM GIC Cho mt hnh ch nht ABCD, cnh AB=a, cnh BC=b. a,b l cc s nguyn dng trong khong [1, 100] Mt im M chy trong on BC vi BM=x . x l s nguyn dung trong khong [0, b], mt im N chy trong on CD vi CN=x Tnh gi tr ln nht v gi tr nh nht ca din tch tam gic AMN khi M, N lu ng.
D liu vo: c cho trong tp tin CHUNHAT.inp, gm mt dng ghi hai s nguyn dng ln lt l a, b. Hai s cch nhau mt khong trng D liu ra : Yu cu xut ra tp tin CHUNHAT.out, gm bn dng: + Dng u l gi tr ln nht ca din tch tam gic AMN (mt ch s thp phn) + Dng th hai l mt gi tr ca x din tch tam gic AMN t gi tr ln nht + Dng th ba l gi tr nh nht ca din tch tam gic AMN (mt ch s thp phn) + Dng th t l mt gi tr ca x din tch tam gic AMN t gi tr nh nht V d: CHUNHAT.inp 10 6 CHUNHAT.out 30.0 0 17.5 5 Yu cu k thut : + C kim tra d liu nhp + Bi lm ca th sinh lu trn tp tin Bailam1.pas CHUNHAT.INP Test 1 10 20 Test 2 40 40
Test 3
10
Test 4
20
10
Test 5
20
CHUNHAT.OUT Sai d liu 800.0 0 (hay 40) 600.0 20 30.0 0 17.5 5 100.0 0 50.0 10 60.0 0 18.0 6
Gv: Tranminhtho
27
GV: Vo Th Lieu
BI 2: BI TON VUNG Cho mt bng ch nht gm m x n im ( m hng ngang, n hng ng) nm trn cc mt li vung. Cc im lin k trn cng mt hng hoc mt ct c th c ni vi nhau bi mt on thng c kch thc bng 1. Trn mi hng c nhiu nht n-1 on thng nm ngang ni cc im lin nhau, trn mi ct c nhiu nht l m-1 on thng thng ng ni cc im lin nhau. Cc on lin k nhau c th s to ra cc vung trn bng (ch quan tm cc vung c di cnh bng 1). Xem hnh di:
Vi bng trn ta c 4 hng ngang (mi hng 5 im) v 5 hng ng (mi hng 4 im). Cc on thng ni chng to nn 3 vung. m t bng ngi ta dng hai mng nh phn: mt mng din t cc on thng nm ngang, mt mng din t cc on thng thng ng. Trong cc mng, s 1 din t c on thng ni hai im lin tip, s 0 din t khng c on thng ni hai im. Trong hnh v trn, (bng c 4x5 im) th ta c hai mng sau: Ngang Dc
1 1 1 0
0 0 1 1
1 0 1 0
0 0 1 0
1 1 1 0 0 1 1 0 0 0 0 1 1 0 0
Nhim v : Lp trnh m s cc vung c cnh d di bng 1 to bi cc on ni c trn bng cho. D liu vo: gm ba tp tin Kthuoc.inp: gm 2 s nguyn dng (nh hn 100) ln lt l m, n. Hai s cch nhau mt khong trng Ngang.inp v Doc.inp ( nh m t phn trn). Hai s lin nhau cch nhau mt khong trng. D liu ra : Xut ra mn hnh s vung c trn bng cho. V d : Kthuoc.inp: 45 Ngang.inp v Doc.inp cha ni dung nh hai bng trn. Xut ra mn hnh : 3 Lu : Ch tnh cc vung c di cnh bng 1 Yu cu k thut : + Khng cn kim tra d liu nhp + Bi lm ca th sinh lu trn tp tin Bailam2.pas HT
28
GV: Vo Th Lieu
Test 3
10
Test 4
20
10
Test 5
20
Bi 2. DOC.INP Test 1 1111111 1100011 1100111 1111111 Test 2 11100 11000 01100 Test 3 001000 001000 001000 001000 001000 Test 4 10110 10101 01101 11011 KTHUOC.INP 5 7 NGANG.INP 111111 110011 110011 110011 111111 1010 1000 1111 0100 00000 00000 11111 00000 00000 00000 1101 0011 1111 1010 1111 13 XUAT
4 5
6 6
5 5
29
GV: Vo Th Lieu
begin {$i-} assign(f,finp); reset(f); close(f); if (IOresult<>0) then begin write('File bi hu hoac khong ton tai'); readln; halt; end; assign(f,finp); reset(f); readln(f,a,b); if (IOresult<>0) or (a<1) or (b<1) or (a<b) or (a>100) or (b>100) then begin write('Nhap sai'); readln; halt; end; {$i+} close(f); end; begin clrscr; nhap; s:=a*b; max:=s/2; min:=max; for i:=0 to b do begin dt:=s-(a*i)/2-((b-i)*i)/2-((a-i)*b)/2; if dt<min then begin luu:=i; min:=dt; end; if dt>max then begin max:=dt; luu1:=i; end; end; assign(g,fout); rewrite(g); writeln(g,max:0:1); writeln(g,luu1); writeln(g,min:0:1); writeln(g,luu); close(g); writeln(max:0:1); writeln(luu1); writeln(min:0:1); writeln(luu); writeln(' Ngoai ra ket qua con duoc xuat vao file CHUNHAT.out'); delay(300); end. BI 2. program bailam2; uses crt; const fin1='kthuoc.inp'; fin2='ngang.inp'; fin3='doc.inp'; var f1,f2,f3:text; a,nga,doc:array[1..100,1..100] of integer; i,m,n,d,j:integer; procedure nhap; var i,j:integer; begin
30
GV: Vo Th Lieu
assign(f1,fin1); reset(f1); read(f1,m,n); close(f1); assign(f2,fin2); reset(f2); for i:=1 to m do begin for j:=1 to n-1 do read(f2,nga[i,j]); readln(f2); end; close(f2); assign(f3,fin3); reset(f3); for i:=1 to m-1 do begin for j:=1 to n do read(f3,doc[i,j]); readln(f3); end; end; begin clrscr; nhap; d:=0; for i:=1 to m do for j:=1 to n do if nga[i,j]+nga[i+1,j]+doc[i,j]+doc[i,j+1]=4 then inc(d); write(d); readln; end.
31
GV: Vo Th Lieu
GV: Vo Th Lieu
C N cng trng cn vt liu thi cng. Cng trng i cn cung cp D[i] n v hng. Hng c cung cp t hai kho A v B. Cc vn chuyn mt n v hng t kho A n cng trng i l A[i]. Cc vn chuyn mt n v hng t kho B n cng trng i l B[i]. Bit rng kho A c R n v hng v tng s hng ca hai kho cung cp cho N cng trng. Yu cu: Hy phn phi hng t hai kho n cc cng trng sao cho tng cc ph vn chuyn l t nht. D liu vo: File HANG.INP c cu trc nh sau: Dng 1: Ghi 2 s N, R (N < 10000) Dng 2: Ghi N s D[1], D[2], , D[N] Dng 3: Ghi N s A[1], A[2], , A[N] Dng 4: Ghi N s B[1], B[2], , B[N] D liu ra: File HANG.OUT c cu trc nh sau: Dng 1: Ghi mt s nguyn dng l tng chi ph vn chuyn t nht. Dng 2: Ghi N s nguyn khng m tng ng s n v hng m kho A cung cp cho cc cng trng 1, 2, , N V d: HANG.INP 7 22 3 9 7 6 11 10 8 13 17 20 9 30 10 19 25 16 22 9 30 4 11 HANG.OUT 835 3 0 7 6 6 0 0 0 9 0 0 5 10 8
Bi 2: CN BNG. (6 im) Coi mt Cy T vi N (1<=N<=20000) nt c nh s t 1..N. Hai nt hoc l ni vi nhau bi mt cnh duy nht hoc khng ni vi nhau. Xo bt c nt no trong cy s sinh ra mt rng: rng l mt tp hp mt hoc nhiu cy. nh ngha cn bng ca mt nt l kch c ca cy ln nht trong rng T c to bi bng cch xo nt T. V d: cho mt cy: 2 1 3
4 33
GV: Vo Th Lieu
Xo nt 4 to ra hai cy vi cc nt ca chng l {5} v {1, 2, 3, 6, 7}. Cy ln hn trong hai cy c 5 nt, do cn bng ca nt 4 l nm Yu cu: D liu vo l mt cy. Tnh xem nt no c cn bng nh nht, nu nhiu nt c cng cn bng, hy in ra nt c th t b nht. D liu vo: File BALANCE.INP c cu trc nh sau: - Dng u: N - Mi dng trong N-1 dng tip theo c hai s ch hai im ca mt cnh trong cy. Khng c cnh no xut hin hai ln trong file, tt c cc cnh c trong cy u c thng bo. D liu ra: File BALANCE.OUT c cu trc nh sau: - Dng u l s th t ca nt c cn bng nh nht. - Dng tip l cn bng ca nt V d: BALANCE.INP BALANCE.OUT 7 1 2 6 2 1 2 1 4 4 5 3 7 3 1
P N
Bi 1. Program bai1; Const fi=hang.inp; fo=hang.out; Type mang=array[0..10000] of integer; Var s:real; n,r,k,w,x,y:integer; a,b,cs:mang; d:^mang; Procedure Nhap; Var i:integer; f:text; Begin assign(f,fi); reset(f); readln(f,n,r); new(d); fillchar(d^,sizeof(mang),0); for i:=1 to n do Begin cs[i]:=i; 34
GV: Vo Th Lieu
read(f,d^[i]); End; for i:=1 to n do read(f, a[i]); for i:=1 to n do read(f, b[i]); close(f); End; {sap xep nhanh theo chi so} Procedure Qsort(l,r:integer); Var i,j,mid,tg:integer; Begin i:=l; j:=r; mid:=a[cs[(l+r) div 2]]-b[cs[(l+r) div 2 ]]; repeat while a[cs[i]]-b[cs[i]]<mid do inc(i); while a[cs[j]]-b[cs[j]]>mid do dec(i); if i<=j then begin tg:=cs[i]; cs[i]:=cs[j]; cs[j]:=tg; inc(i); dec(j); end; until i>j; if l<j then Qsort(l,j); if i<r then Qsort(i,r); End; Procedure TimK; Var i,t:integer; Begin s:=0; t:=0; k:=0; while t+d^[cs[k]]<r do begin inc(k); t:=t+d^[cs[k]]; s:=s+a[cs[k]]*d^[cs[k]]; a[cs[k]:=-a[cs[k]]; end; x:=r-t; y:=d^[cs[k+1]]-(r-t); s:=s+a[cs[k+1]]*x+b[cs[k+1]]*y; for i:=k+2 to n do s:=s+b[cs[i]]*d^[cs[i]]; w:=cs[k+1]; End; Procedure Xuat; Var i:integer; g:text; Begin assign(g, fo); 35
GV: Vo Th Lieu
rewrite(g); writeln(g,s:0:0); for i:=1 to w-1 do if a[i]<0 then write(g,d^[i], write(g,x, ); for i:=w+1 to n do if a[i]<0 then write(g,d^[i], writeln(g); for i:=1 to w-1 do if a[i]>0 then write(g,d^[i], write(g,y, ); for i:=w+1 to n do if a[i]>0 then write(g,d^[i], close(g); dispose(d); End; BEGIN Nhap; Qsort(1,n); TimK; Xuat; END.
Bi 2: Program bai2; Const fi= BALANCE.INP; fo= BALANCE.OUT; max=20000; Type m1=array[0..max+1] of integer; Var n:integer; a:m1; d,c,tr,t:^m1; f:text; Procedure Nhap; Var i:integer; Begin new(d); new(c); new(tr); new(t); assign(f,fi); reset(f); readln(f,n); for i:=1 to n-1 do readln(f,d^[i],c^[i]); close(f); End; Procedure Xuat; Var i,min:integer; Begin dispose(d); dispose(c); dispose(tr); 36
GV: Vo Th Lieu
dispose(t); min:=1; for i:=2 to n do if a[i]<a[min] then min:=i; assign(f,fo); rewrite(f); writeln(f,min); writeln(f,a[min]); close(f); End; Procedure Xuli; Var i,j,dem,bac,x,y:word; Begin fillchar(a,sizeof(a),0); for i:=1 to n do t^[i]:=1; dem:=0; while dem<n-2 do begin for i:=1 to n-1 do begin x:=d^[i]; y:=c^[i]; if (a[x]<>-1) and (a[y]<>-1) then begin inc(a[x]); tr^[x]:=y; inc(a[y]); tr^[y]:=x; end; end; for i:=1 to n-1 do if a[i]=1 then begin a[i]:=-1; inc(t^[tr^[i]],t^[i]); inc(dem); end else if a[i]<>-1 then a[i]:=0; end; for i:=1 to n do begin if a[i]=0 then tr^[i]:=0; a[i]:=n-t^[i]; end; for i:=1 to n do if t^[i]>a[tr^[i]] then a[tr^[i]]:=t^[i]; End; BEGIN Nhap; Xuli; Xuat; END. 37
GV: Vo Th Lieu
Yu cu: Mi th sinh to mt Folder mang tn l: K9-<S bo danh ca th sinh > cha trong D:\ v lu cc file sau vo ng Folder va to. Cu 1 (3 im) : To file mang tn BAI1.PAS thc hin chng trnh sau : Kt qu thi ca hc sinh gm nhng thng tin sau: H tn, lp, im ton (DT), im vn(DV), im trung bnh (DTB), xp loi(XL). Trong : im trung bnh c tnh nh sau: DTB=(DT*2+DV)/3 Xp loi da trn im trung bnh nh sau:
Nu DTB>=8.0, xp loi gii Nu 8.0>DTB>=6.5, xp loi kh. Nu 6.5>DTB>=5.0, xp loi trung bnh Cn li xp loi cha t
Hy vit chng trnh di dng cc chng trnh con thc hin vic in ra mn hnh danh sch hc sinh theo th t gim dn ca im trung bnh km theo cc thng tin: H tn, lp, im trung bnh, xp loi. Cu 2 (3 im) : To file mang tn BAI2.PAS thc hin chng trnh sau : Vit chng trnh theo yu cu sau: Khi nhn phm n hoc N: chng trnh thc hin i mt s thp phn sang dy s nh phn. Khi nhn phm t hoc T: chng trnh thc hin i dy s nh phn sang s thp phn. Cu 3 (4 im) : To file mang tn BAI3.PAS thc hin chng trnh sau: Hai file SN1.TXT, SN2.TXT cha cc s nguyn bt k. Hy vit chng trnh to file KQ.OUT cha cc s nguyn c sp xp theo th t tng dn, mi s trong file KQ.OUT l tng ca hai s nguyn ly t file SN1.TXT v SN2.TXT. V d: File SN1.TXT cha cc s nguyn: 1 nguyn: 31 5 9 7 12; SN2.TXT cha cc s 2 1 th file KQ.OUT c kt qu: 9 13 14 32.
38
GV: Vo Th Lieu
p n
Bi 1: type HS=record ht:string; lop:string[10]; dt,dv,dtb:real; xl:string[10]; end; hs1=array[1..20] of hs; var hss:hs1; i,j,n:integer; procedure nhap(var hss:hs1); begin writeln(' nhap thong tin cho hoc sinh:'); for i:=1 to n do begin with hss[i] do begin writeln(' nhap ho ten'); readln(ht); writeln(' nhap lop'); readln(lop); writeln(' nhap diem toan'); readln(dt); writeln(' nhap diem van'); readln(dv); dtb:=(dt*2+dv)/3; if dtb>=8.0 then xl:=' loai gioi' else if dtb>=6.5 then xl:='loai kha' else if dtb>=5.0 then xl:='loai trung binh' else xl:=' loai chua dat'; end; end; end; {------------------------} procedure sx(var hss:hs1); var tam:hs; begin for i:=1 to n-1 do for j:=i+1 to n do if hss[i].dtb<hss[j].dtb then begin tam:=hss[i]; hss[i]:=hss[j]; hss[j]:=tam; end; readln; end; Begin writeln(' nhap so hoc sinh'); readln(n); nhap(hss); sx(hss); writeln(' ket qua sau khi sap xep'); for i:=1 to n do with hss[i] do begin writeln(ht,' ',lop,' ',dtb:0:2,' ',xl); 39
GV: Vo Th Lieu
end; readln; End. Bi 2: var st,st2:string; p,i,n,j,t:integer; ch,ch1:char; procedure nhap; begin writeln('nhap so thap phan n:'); readln(n); end; procedure doinp(n:integer); var st1,stt:string;t,d:integer; begin st1:=''; repeat t:=n div 2; d:=n mod 2; n:=t; str(d,stt); st1:=st1+stt; until t=0; for i:=length(st1) downto 1 do write(st1[i]:3); writeln; end; function hammu(n:integer):integer; var p:integer; begin if n=0 then hammu:=1 else begin p:=1; for i:=1 to n do begin p:=P*2; end; hammu:=p; end; end; procedure doitp(st:string;var t:integer); var so,k,i:integer; begin t:=0; for i:=1 to length(st) do begin val(st[i],k,so); t:=t+k*hammu(length(st)-i); end; end; BEGIN repeat writeln(' moi ban chon chuc nang'); readln(ch1); 40
GV: Vo Th Lieu
case ch1 of 'n': begin nhap; writeln('so thap phan', n ,' doi thanh day nhi phan:'); doinp(n); end; 't': begin writeln(' moi ban nhap day so nhi phan can doi'); readln(st2); doitp(st2,t); writeln(t); end; end; writeln('doi nua khong?'); readln(ch); until ch in['k','K']; END. Bi 3: type f=file of integer; var f1,f2,f3:f; i,j,n,m,tam:integer; ch:char; procedure taofile(var f1,f2:f); begin assign(f1,'c:\f1.txt'); rewrite(f1); assign(f2,'c:\f2.txt'); rewrite(f2); repeat writeln(' nhap gia tri cho file f1'); readln(n); write(f1,n); writeln('Tiep tuc?'); readln(ch); until ch in['k','K']; repeat writeln(' nhap gia tri cho file f2'); readln(m); write(f2,m); writeln('Tiep tuc (c/k)?'); readln(ch); until ch in['k','K']; close(f1); close(f2); readln; end; procedure taokq(var f3:f); var i,u,v:integer; Begin assign(f1,'c:\f1.txt'); reset(f1); assign(f2,'c:\f2.txt'); reset(f2); 41
GV: Vo Th Lieu
assign(f3,'c:\f3.out'); rewrite(f3); {while not eof(f1) do begin while not eof(f2) do begin read(f1,n); read(f2,m); tam:=n+m; write(f3,tam); end; end;} n:=filesize(f1); m:=filesize(f2); if n<=m then begin for i:=1 to n do begin read(f1,u); read(f2,v); u:=u+v; write(f3,u); end; for i:=n+1 to m do begin read(f2,u); write(f3,u); end; end else begin for i:=1 to m do begin read(f1,u); read(f2,v); u:=u+v; write(f3,u); end; for i:=m+1 to n do begin read(f1,u); write(f3,u); end; end; close(f1); close(f2); close(f3); end; BEGIN taofile(f1,f2); taokq(f3); assign(f3,'c:\f3.out'); 42
GV: Vo Th Lieu
reset(f3); writeln('file kq co ',filesize(f3),' phan tu la:'); while not eof(f3) do begin read(f3,n); writeln(n); end; readln; end.
thi th
1.
D lieu vao: Chui s v chui s1. Ket qua ra: Cc v tr tm thy s1 trong s. V du: Input Test 1 aaahocjhochoc 4 hoc Test 2 adddddee 2 dd
Output 8 11 3 4 5
2. Nhap vao mot chuoi sau o xuat ra (cac)t dai nhat trong chuoi? (6)
D lieu vao: Mot chuoi. Ket qua ra: Cac t dai nhat trong chuoi. V du: Input Output Test 1 Tran Nguyen dao Nguyen Test 2 Tran quang bgggg dao quang bgggg
GV: Vo Th Lieu
44
GV: Vo Th Lieu
AP AN
Timchuoi.pas var s,s1:string; begin readln(s); readln(s1); while pos(s1,s)>0 then begin write(pos(s1,s):4); s[pos(s1,s)]:=chr(1); end; readln; end. 1. Tu-max.pas var s,s1:string; a:array[1..128]of string; i,j,max:integer; begin readln(s); while s[1]=#32 do delete(s,1,1); while s[length(s)]=#32 do delete(s,length(s),1); while pos(#32#32,s)>0 do delete(s,pos(#32#32,s),1); j:=1; for i:=1 to length(s) do begin if s[i]<>#32 then a[j]:=a[j]+s[i] else inc(j); end; max:=length(a[1]); for i:=1 to j do if length(a[i])>max then max:=length(a[i]); writeln('(cac) tu dai nhat: (co ',max,' ky tu:)'); for i:=1 to j do if length(a[i])=max then writeln(a[i]); readln; end. 2. 2 chuong trinh a. Mahoa.pas uses crt; var s:string; i:integer; begin clrscr; writeln('Nhap chuoi can ma hoa:'); readln(s); writeln('Ma hoa thanh cac con so la:'); for i:=1 to length(s) do begin s[i]:=upcase(s[i]); write(ord(s[i])); end; readln; end. b. Giaima.pas uses crt; var s,s2:string; ch:char; 45
GV: Vo Th Lieu
i,x,d:integer; begin clrscr; writeln('Nhap chuoi so mat ma:'); readln(s); writeln('Giai ma chuoi so tren la:'); while length(s)>0 do begin s2:=copy(s,1,2); {lay moi lan 2 ky tu dau tien} delete(s,1,2); {xoa 2 ky tu da lay di} val(s2,x,i); {chuyen thanh so x} write(chr(x)); {chuyen thanh ma asscii} end; readln; end.
46