Tin học Lập trình Pascal !

L

longvipkute

may bai nay de quá ak. Tui có mấy bài chất lượng hon nè. :)>-:)>-:)>-:)>-:)>-:)>-:-SS:-SS:-SS:-SS:D:D:D:D@};-
 
L

lamoanh_duyenthuc

bạn nào vjhoojooj mjnhf cái chương trình nj với
1.viết chương trình chuẩn hóa một xâu S
2.viết chương trình kiểm tra một dãy có là dãy điều hòa hay không ?
3. tệp vào là 'BT.INP' chứa đường ,mỗi dường chưa n số nguyên (mỗi số cách nahu một dấu cách .) tạo tệp ra 'BT.OUT' chứa các dường chéo song song với dường chéo chính
 
D

duynhan1

Chương trình tính tổng các phần tử là số nguyên tố!
PHP: 
Var i,sum,N:longint;
     a:array[1..100] of longint;
Function Ktra(a:longint):boolean;
Var i:integer;
    b:boolean;
Begin
b:=True;
For i:=2 to trunc(sqrt(a)) do
  If a mod i=0 then b:=False;

Ktra:=b;
End;


BEGIN
   Write('Nhap N=');
   Readln(N);
   For i:=1 to N do
       Begin
          Write('Nhap A[',i,']: ');
          Readln(a[i]);
       End;
   sum:=0;
   For i:=1 to N do
      If Ktra(a[i]) then sum:=sum+a[i];

   Write('Tong cac so nguyen to la:',sum);
End.
 
V

vanhaipro

lamoanh_duyenthuc said:
bạn nào vjhoojooj mjnhf cái chương trình nj với
1.viết chương trình chuẩn hóa một xâu S
2.viết chương trình kiểm tra một dãy có là dãy điều hòa hay không ?
3. tệp vào là 'BT.INP' chứa đường ,mỗi dường chưa n số nguyên (mỗi số cách nahu một dấu cách .) tạo tệp ra 'BT.OUT' chứa các dường chéo song song với dường chéo chính
Bấm để xem đầy đủ nội dung ...
mình cũng khoái giải thuât lắm.
Mình sắp đi học nên chỉ làm câu 1 nhé:
chuẩn hoá
Mã: 
[COLOR="Blue"]uses[/COLOR] crt;
[COLOR="blue"]var[/COLOR] S:string;
[COLOR="blue"]begin[/COLOR] clrscr;
  readln(S);
  [COLOR="blue"]while[/COLOR] S[length(S)]=' ' [COLOR="blue"]do[/COLOR] delete(S,length(S),1);
  [COLOR="blue"]while[/COLOR] S[1]=' ' [COLOR="blue"]do[/COLOR] delete(S,1,1);
  [COLOR="blue"]while[/COLOR] pos('  ',S)<>0 [COLOR="blue"]do[/COLOR] delete(S,pos('  ',S),1);
  writeln(S);
  readln;  
[COLOR="blue"]end.[/COLOR]
 
T

thai_tin

Bài tập pascal

Nhờ các pro giải hộ mấy bài tập sau:
Bai 1. Cho đoạn thẳng [a. b] và dãy các đoạn thẳng [a1.b1], [a2,b2]…[as,bs] biết rằng với mỗi i=1,2,3…n thì hoặc a>a1 hoặc b< bi hỏi có phần nào là riểng của đoạn [a,b] tức là điểm thuộc [a,b] mà không thuộc [ai,bi] với b bất kì số i nào đó từ 1..n k? Hãy lập trình để giải bài toán trên. Dữ liệu nhập từ bàn phím a,b,n,ai, bi i=1,2, n kết quả hiện ra màn hình.
Bai 2.
Tên file chương trình là FUNCTER.PAS.
Trên mặt phẳng toạ độ, xét các điểm có toạ độ nguyên. Ban đầu có N điểm màu đỏ có toạ độ nguyên. Một người thực hiện các thao tác sau: Với 2 điểm màu đỏ cùng trên một dòng hay 2 điểm màu đỏ cùng trên một cột thì nối 2 điểm đó trên bằng một đoạn thẳng, các điểm có toạ độ nguyên trên đọan thẳng vừa vẽ đó được tô màu đỏ. Người đó cứ làm như vậy cho đến khi không còn điểm màu đỏ nữa mới thôi.
Yêu cầu: Hãy lập trình tính xem cuối cùng có bao nhiêu điểm màu đỏ trên mặt phẳng toạ độ (kể cả N điểm ban đâu.)
Dữ liệu vào: Đọc từ file văn bản PUNCTER.INP.
- dòng đầu ghi số N(1 <= N <= 100).
- Tiếp theo là N dòng mỗi dong ghi hai số nguyên(2 số nguyên đó trị tuyệt đối không quá 100)là toạ độ của một diểm màu đỏ, hai điểm khác nhau có toạ độ khác nhau .Các số trên cùng một dòng cách nhau ít nhất 1 dấu cách.
Dữ liệu ra: ghi ở file văn bản PUNCTER.OUT. ghi một số duy nhất là điểm màu đỏ trên mặt phẳng toạ độ(kể các N điểm đỏ ban đâu).
PUNCTER.INP
4
0 2
3 1
1 4
4 4
PUNCTER.OUT
12
Mong sớm nhận được hồi âm. Cảm hơn các pro trước.
 
D

duynhan1

thai_tin said:
Nhờ các pro giải hộ mấy bài tập sau:
Bai 1. Cho đoạn thẳng [a. b] và dãy các đoạn thẳng [a1.b1], [a2,b2]…[as,bs] biết rằng với mỗi i=1,2,3…n thì hoặc a>a1 hoặc b< bi hỏi có phần nào là riểng của đoạn [a,b] tức là điểm thuộc [a,b] mà không thuộc [ai,bi] với b bất kì số i nào đó từ 1..n k? Hãy lập trình để giải bài toán trên. Dữ liệu nhập từ bàn phím a,b,n,ai, bi i=1,2, n kết quả hiện ra màn hình.
Bấm để xem đầy đủ nội dung ...

Bài 1, tư tưởng đơn giản nhất là Sort theo thứ tự tăng dần của ai rồi xét. ( ở đây mình dùng Qsort)

PHP: 
var a,b:array[0..1000] of integer;
    n:integer;
Procedure Sort(L,H:integer);
Var i,j,k,t1,t2:integer;
Begin
  If L>=H then exit;
  i:=L;
  j:=H;
  k:=a[(L+H) div 2];
  Repeat
  While a[i]<k do inc(i);
  While a[j]>k do dec(j);
  IF i<=j then
    Begin
       If i<j then
          Begin
            t1:=a[i];    t2:=b[i];
            a[i]:=a[j];  b[i]:=b[j];
            a[j]:=t1;    b[j]:=t2;
          End;
       inc(i);
       dec(j);
    End;
  Until i>j;

    Sort(L,j);
    Sort(i,H);
End;

Procedure Enter;
Var ad,bd,i:integer; //Chinh la 2 diem a,b trong de bai
Begin
Readln(N,ad,bd);
For i:=1 to n do Readln(a[i],b[i]);
Sort(1,n); //Sap xep tang dan theo ai
b[0]:=ad; a[n+1]:=bd; // Khoi tao.
End;

Procedure Process;
Var i,dem:integer;
Begin
dem:=0;
For i:=1 to n+1 do
Begin
If b[i-1]<a[i] then
begin
inc(dem);
Writeln('(',b[i-1],';',a[i],')');
End;
If b[i]<b[i-1] then b[i]:=b[i-1]; //Cap nhat diem cuoi lon nhat hien tai
End;
If dem=0 then Write('Khong co diem nao thoa man')
Else Write('Co ',dem, ' khoang thoa man');
End;

BEGIN
Enter;
Process;
END.
 
D

duynhan1

thai_tin said:
Bai 2.
Tên file chương trình là FUNCTER.PAS.
Trên mặt phẳng toạ độ, xét các điểm có toạ độ nguyên. Ban đầu có N điểm màu đỏ có toạ độ nguyên. Một người thực hiện các thao tác sau: Với 2 điểm màu đỏ cùng trên một dòng hay 2 điểm màu đỏ cùng trên một cột thì nối 2 điểm đó trên bằng một đoạn thẳng, các điểm có toạ độ nguyên trên đọan thẳng vừa vẽ đó được tô màu đỏ. Người đó cứ làm như vậy cho đến khi không còn điểm màu đỏ nữa mới thôi.
Yêu cầu: Hãy lập trình tính xem cuối cùng có bao nhiêu điểm màu đỏ trên mặt phẳng toạ độ (kể cả N điểm ban đâu.)
Dữ liệu vào: Đọc từ file văn bản PUNCTER.INP.
- dòng đầu ghi số N(1 <= N <= 100).
- Tiếp theo là N dòng mỗi dong ghi hai số nguyên(2 số nguyên đó trị tuyệt đối không quá 100)là toạ độ của một diểm màu đỏ, hai điểm khác nhau có toạ độ khác nhau .Các số trên cùng một dòng cách nhau ít nhất 1 dấu cách.
Dữ liệu ra: ghi ở file văn bản PUNCTER.OUT. ghi một số duy nhất là điểm màu đỏ trên mặt phẳng toạ độ(kể các N điểm đỏ ban đâu).
PUNCTER.INP
4
0 2
3 1
1 4
4 4
PUNCTER.OUT
12
Mong sớm nhận được hồi âm. Cảm hơn các pro trước.
Bấm để xem đầy đủ nội dung ...
Bài này tọa độ khá nhỏ, ta có thể dùng mảng 2 chiều [-100..100,-100..100] để lưu tọa độ, mỗi ô nhận 2 giá trị 0 hoặc 1 tương ứng với có điểm đỏ hoặc ko có điểm đỏ.

Dùng lệnh While do kết hợp với 2 vòngFor ( để nối ngang và dọc). Nếu 2 vòng For mà ko có điểm nào được nối thêm thì thoát khỏi While do và đếm số 1.
 
T

thai_tin

cảm ơn các pro nhiêu. Đây đúng là một diễn đàn rất hay.thankoy very much admin
 
T

thai_tin

Mình còn rất nhiều bài tập hay mà không biết thảo luận cùng ai.may mà cỏ forum này.
Bài 2 mình cũng đã làm theo ý tưởng của bạn nhưng chưa chạy được.mình sẽ thử lại xem sao?
Còn đây là một bài mình cũng chưa chạy được
Cho trước một xâu kí tự, trong đó có ít nhất 4 chữ sô. Hãy loại bỏ một số kí tự khỏi xâu sao cho 4 kí tự cuối cùng còn lại theo đúng thứ tự lập nên một số lớn nhất. Hãy lập trình để giải bài toán trên.
 
D

duynhan1

thai_tin said:
Mình còn rất nhiều bài tập hay mà không biết thảo luận cùng ai.may mà cỏ forum này.
Bài 2 mình cũng đã làm theo ý tưởng của bạn nhưng chưa chạy được.mình sẽ thử lại xem sao?
Còn đây là một bài mình cũng chưa chạy được
Cho trước một xâu kí tự, trong đó có ít nhất 4 chữ sô. Hãy loại bỏ một số kí tự khỏi xâu sao cho 4 kí tự cuối cùng còn lại theo đúng thứ tự lập nên một số lớn nhất. Hãy lập trình để giải bài toán trên.
Bấm để xem đầy đủ nội dung ...

Đây là suy nghĩ của mình :
-Loại bỏ hết các ký tự không phải là số.
-Để được số lớn nhất thì số đầu phải max.
-Dò tìm số max trong dãy rồi lấy ở vị trí đầu tiên. Làm tương tự cho 3 chữ số còn lại.

Ví dụ :
4a9s15u2j9j321
-->491529321
max là 9. Số đầu tiên ở vị trí 2 của xâu.
Số thứ 3 được tìm ở sau số thứ 1 --> số lenght(s) - 2 9 đảm bảo còn lại 2 số)
ta được tiếp số 9

tương tự như vậy
 
Last edited by a moderator:
T

thienhoang_0nline

có ai biết cách tạo lập trang web không bảo mình với!!
sắp lên cấp 3 rùi!
mình muốn lam 1 trang web cho lớp để lưu
trữ những kỉ niệm đẹp!!
ai bít giúp mình với!!!
:khi (59): :khi (59): :khi (59): :khi (59): :khi (59): :khi (59)::khi (59):
 
B

bachoc9x

thai_tin said:
Mình còn rất nhiều bài tập hay mà không biết thảo luận cùng ai.may mà cỏ forum này.
Bài 2 mình cũng đã làm theo ý tưởng của bạn nhưng chưa chạy được.mình sẽ thử lại xem sao?
Còn đây là một bài mình cũng chưa chạy được
Cho trước một xâu kí tự, trong đó có ít nhất 4 chữ sô. Hãy loại bỏ một số kí tự khỏi xâu sao cho 4 kí tự cuối cùng còn lại theo đúng thứ tự lập nên một số lớn nhất. Hãy lập trình để giải bài toán trên.
Bấm để xem đầy đủ nội dung ...

PHP: 
Var s,s1:string;
    i,j,i1:integer;
Begin
  Write('Nhap xau: ');readln(s);
  For i:=1 to length(s) do
   if not (s[i] in ['0'..'9']) then delete(s,i,1);
  j:=3;
  While j>=0 do
    Begin
      i1:=1;
      For i:=1 to length(s)-j do
        If s[i]>s[i1] then i1:=i; 
      s1:=s1+s[i1];        
      delete(s,1,i1);   
      dec(j);
    End;
  s:=s1;
  write('So can tim: ',s);
  readln;
End.
Tớ đang cần tài liệu nâng cao pascal. Bạn nào có cho tớ với.
Thanks!!!!
 
Last edited by a moderator:
T

thai_tin

chương trinh trên chưa xử lý được xâu sau:3ab69210 nó cho kết quả là:b921 kết quả fiar là 6921
 
D

duynhan1

bachoc9x said:
PHP: 
Var s,s1:string;
    i,j,i1:integer;
Begin
  Write('Nhap xau: ');readln(s);
  For i:=1 to length(s) do
   if not (s[i] in ['0'..'9']) then delete(s,i,1);
Tớ đang cần tài liệu nâng cao pascal. Bạn nào có cho tớ với.
Thanks!!!!
Bấm để xem đầy đủ nội dung ...

Do độ dài của s sẽ thay đổi khi dùng thủ tục delete nên ta sẽ sử dụng While do và delete từ đầu xậu
PHP: 
i:=1;
While (i<=length(s)) do  
    If (s[i>='0') and (s[i]<='9') then inc(i) else delete(s,i,1);

@bacho9x: Bạn có thể down cuốn sách "Cấu trúc dữ liệu giải thuật-Lê Minh Hoàng" về coi :D
 
B

bachoc9x

duynhan1 said:
Do độ dài của s sẽ thay đổi khi dùng thủ tục delete nên ta sẽ sử dụng While do và delete từ đầu xậu
PHP: 
i:=1;
While (i<=length(s)) do  
    If (s[i>='0') and (s[i]<='9') then inc(i) else delete(s,i,1);
@bacho9x: Bạn có thể down cuốn sách "Cấu trúc dữ liệu giải thuật-Lê Minh Hoàng" về coi :D
Bấm để xem đầy đủ nội dung ...
Uk. Tớ thử mấy xâu vẫn đúng nên ko để í.
Bạn cho link đi. Tớ cần để ôn. Tháng 8 tớ phải thi.
 
You must log in or register to reply here.
Top Bottom