VuaTenMien.Com: tháng 5 2012

Thứ Bảy, 26 tháng 5, 2012

Ngày tháng năm sau ngày được nhập N ngày

Đề bài: Nhập ngày tháng năm. Hãy cho biết ngày tháng năm sau đó N ngày.

var d,m,y,n:integer; 

Function      Songay(thang,nam: Integer):Integer;
Var             sn:Integer;
Begin
       Case thang of
                1,3,5,7,8,10,12 : sn:= 31;
                4,9,11             : sn:= 30;
                2:   If (nam MOD 4 = 0) Then
                           sn:= 29
                      Else
                            sn:= 28;
        End;
        Songay:= sn;
End;
BEGIN
     Writeln('Nhap ngay thang nam');Readln(d,m,y);
     Writeln('Nhap N');Readln(N);
     d:=d+N;
     While d > Songay(m,y) Do
     Begin
         d:= d - Songay(m,y);
         m:= m+1;
         IF m > 12 Then
         Begin
              m:= 1;
              y:= y + 1;
         End;
    End;
Writeln('Ket qua ',d,'/',m,'/',y);
Readln;
END.

Thể Tích Khối Tròn Xoay

In ra tệp các phần tử xuất hiện trong tệp từ k lần trở lên

Nhập một dãy A (mỗi số chỉ xuất 1 lần) có N (< 40) số tự nhiên và 1 số K. Hãy xuất ra các phần tử có số lần xuất hiện trong dãy A từ K lần trở lên.
Dữ liệu nhập: file DAYSO.INP:
- Dòng 1: 2 số n và k cách nhau bởi 1 dấu cách.
- Dòng 2: dãy A.
Dữ liệu ra: file DAYSO.OUT: Xuất các số thỏa điều kiện trên.

uses crt;
var a,b:array[0..100] of integer;
    n,j,i,k:integer;
    f:text;

Procedure docf;
begin
assign(f,'C:\DAYSO.INP');
reset(f);
i:=0;
     read(f,n);
     readln(f,k);
     While not eof(f) do
      begin
        inc(i);
        read(f,a[i]);
      end;
      close(f);
end;

Procedure xuly;
begin
assign(f,'C:\DAYSO.OUT');
rewrite(f);
FillChar(b,SizeOf(b),0);
   For i:=1 to n do inc(b[a[i]]);
   For i:=1 to n do
        if (b[i]<>0) (b[i]>=k) then
           write(f,i,' ');
close(f);
end;

BEGIN
clrscr;
docf;
xuly;
readln

end.

Chú thích:

- Hàm Fillchar(x,sizeof(x),i): điền lần lượt các byte của dữ liệu này bằng giá trị byte của i (i được coi là chiếm một byte).

Như vậy, đối với mảng kiểu integer hay longint (cả số cũng vậy), máy sẽ điền lần lượt các byte của dữ liệu:
Fillchar 1=00000001 (1 byte= 8 bit -> phải có đủ 8 chữ số cả 0 và 1).

- Sizeof(x): Trả về kích thước của biến trong bộ nhớ.

Diện Tích Hình Phẳng

Tìm các số tổng các các ước của số này bằng số kia và ngược lại

Hai số m,n gọi là bạn của nhau nếu tổng các ước của m bằng n và ngược lại.Tìm tất cả các số là bạn của nahu và nhỏ hơn 10001.

Ý tưởng: Thay vì chạy 2 vòng lặp để xét m và n, ta có thể chỉ cần chạy 1 vòng lặp kiểm tra xem m và uoc(m) có là bạn của nhau không.

PROGRAM timban;
FUNCTION uoc(k:INTEGER):longint;
VAR i,tong:INTEGER;
BEGIN
tong:=0;
FOR i:=1 TO k DIV 2 DO
IF k MOD i =0 THEN tong:=tong+i;
uoc:=tong;
END;
VAR m:longint;
BEGIN
for m:= 1 to 10001 do
if uoc(uoc(m)) = m then writeln(m, ' va ', uoc(m),' la ban cua nhau');
readln
END.