Liệt kê dãy nhị phân cụm "01" xuất hiện đúng 2 lần

Đề bài: Hãy liệt kê dãy nhị phân độ dài n mà trong đó cụm "01" xuất hiện đúng 2 lần.

uses crt;
var s,n,j,i:integer;
a:Array[1..100] of integer;

{--------------------------}

Procedure print;
var j:integer;
begin
For j:=1 to n do write(a[j],' ');
writeln;
end;

{--------------------------}

Procedure Deq(i:integer);
 var j,k,d:integer;
  begin
   For j:=0 to 1 do
     begin
       d:=0;
       a[i]:=j;
       if i=n then
       For k:=1 to n do
         begin
          if (a[k]=0) and (a[k+1]=1) then inc(d);
          if d=2 then  print
         end
       else Deq(i+1);
      end;
  end;
{--------------------------}
Begin
 clrscr;
 write('Nhap n= ');readln(n);

Deq(1);
readln

end.

Xâu thuần nhất (Giải nén xâu trong pascal)

Xâu kí tự thuần nhất được định nghĩa là xâu chỉ bao gồm các chữ cái tiếng anh. Một xâu thuần nhất có thể được viết thu gọn, bao gồm các số thứ tự kèm theo tần số xuất hiện liên tiếp của nhóm đó!
VD: AACCBBB<-->A2B2C3
XCAABAABAABCCADADCADCAABAABCCADADY<-->X(C(A2B)3C2(AD)2)2Y
(AB)2(QXA)3<-->ABABQXAQXAQXA
Hãy viết chương trình thu gọn và giải mã (hay nén và giải nén) xâu.


Thuật toán dưới đây là quá trình nén xâu.

program xau_thuan_nhat;
uses crt;
var s,ss,st,si:string; i,j,l:integer;
function kttn(s:string):boolean;
 var x:char; ok:boolean;
 begin
  kttn:=true;
  for i:=1 to length(s) do
   s[i]:=upcase(s[i]);
  for i:=1 to length(s) do
   begin
    ok:=false;
    for x:='A' to 'Z' do
     if s[i]=x then ok:=true;
    if not ok then begin kttn:=false;break;end;
   end;
 end;
procedure nen(s:string;var st:string);
 begin
  ss:='';
  while s<>'' do
   begin
    i:=1;
    while (s[i+1]=s[1])and(i<length(s)) do
     inc(i);
    if i>1 then
     begin
      str(i,si);
      ss:=ss+s[1]+si;
     end
    else ss:=ss+s[1];
    delete(s,1,i);
   end;

  s:=ss;l:=2;
  while l<length(s) do
   begin
    i:=1;
    while i<=length(s)-l do
     begin
      si:=copy(s,i,l);
      j:=i+l;
      ss:=copy(s,j,l);
      while ss=si do
       begin
        j:=j+l;
        ss:=copy(s,j,l);
       end;
      if j=i+l then inc(i)
      else
       begin
        str((j-i)div l,ss);
        delete(s,i,j-i);
        si:='('+si+')'+ss;
        insert(si,s,i);
        i:=i+l+2+length(ss);
       end;
     end;
    inc(l);
   end;
  st:=s;
 end;
function ktcd(st:string):boolean;
 begin
  ktcd:=false;
  for i:=1 to length(st) do
   if st[i]='(' then begin ktcd:=true; break; end;
 end;
procedure giainen(st:string;var s:string);
 var d,c:byte; code:integer;
 begin
  while ktcd(st) do
   begin
    i:=1; c:=0;
    while st[i]<>'(' do inc(i);
    d:=1; j:=i+1;
    while c<d do
     begin
      inc(j);
      if st[j]='(' then inc(d);
      if st[j]=')' then inc(c);
     end;
    si:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    delete(si,1,1);
    delete(si,length(si),1);
    j:=i;
    while st[j+1] in['0'..'9'] do inc(j);
    ss:=copy(st,i,j-i+1);
    delete(st,i,j-i+1);
    val(ss,l,code);
    for j:=1 to l do
     insert(si,st,i);
   end;
  i:=1;
  while i<=length(st) do
   begin
    inc(i);
    if st[i] in['0'..'9'] then
     begin
      j:=i;
      while st[j+1] in['0'..'9'] do inc(j);
      ss:=copy(st,i,j-i+1);
      delete(st,i,j-i+1);
      val(ss,l,code);
      ss:=st[i-1];
      for j:=1 to l-1 do insert(ss,st,i);
      i:=i+l-1;
     end;
   end;

  s:=st;
 end;
begin
 clrscr;
 write('nhap chuoi: ');readln(s);
 if kttn(s) then
  begin
   nen(s,st);
   writeln('Chuoi sau khi nen la: ',st);
   giainen(st,s);
   writeln('Chuoi sau khi giai nen la: ',s);
  end
 else write('Xau ko thuan nhat.');
readln;
end.

Tìm tổng các số bất kỳ từ dãy 1,2,2,3,3,3,4,4,4,4...

Cho mảng A là dãy số 1,2,2,3,3,3,4,4,4,4,5,5,5,5,5.... Nhập vào số m, n (m<=n<=100000). In ra tổng A[m]+A[m+1]+...+A[n-1]+A[n].

 
program code;
var di:word;
    m,n,i,res:longint;

begin
   writeln('Nhap M: '); readln(m);
   writeln('Nhap N: '); readln(n);
   di:=0;
   i:=0;
   res:=0;
   while i<m do
    begin
      di:=di+1;
      i:=i+di;
    end;
    res:=(i-m+1)*di;
    while i<=n do
     begin
        di:=di+1;
        i:=i+di;
        res:=res+di*di;
     end;
    res:=res-di*(i-n);

   writeln('Ket qua: ',res);
   readln;
end.

100 đề toán tin dành cho THCS & THPT - Tin học và Nhà trường (có lời giải)

Cuốn tài liệu gồm 100 đề toán tin dành cho cấp tiểu học, THCS và THPT. Các bài tập đều rất hay và đòi hỏi tư duy cao. Cuốn 100 đề Tin học và Nhà trường này thật sự rất hữu ích cho những bạn học chuyên sâu, chuẩn bị thi HSG.

100 đề TIN HOC VÀ NHÀ TRƯỜNG

Download: http://www.mediafire.com/?dqcr38i4xi8669v
Ngoài ra, các bạn có thể xem online tại đây.

Tài liệu từ internet

Các thuật toán sắp xếp trong Pascal: Selection Sort, Insert Sort, Bubble Sort, QuickSort

Sắp xếp là thuật toán căn bản không chỉ trong ngôn ngữ lập trình Pascal mà còn trong nhiều lĩnh vực công nghệ khác. Bài viết sau sẽ để cập đến một số thuật toán sắp xếp bằng ngôn ngữ Pascal.

1. Bubble Sort (Sắp xếp nổi bọt)

Ý tưởng: Giả sử có mảng có n phần tử. Chúng ta sẽ tiến hành duyệt từ cuối lên đầu,so sánh 2 phần tử kề nhau, nếu chúng bị ngược thứ tự thì đổi vị trí, việc duyệt này bắt đầu từ cặp phần tử thứ n-1 và n. Tiếp theo là so sánh cặp phần tử thứ n-2 và n-1,… cho đến khi so sánh và đổi chỗ cặp phần tử thứ nhất và thứ hai. Sau bước này phần tử nhỏ nhất đã được nổi lên vi trí trên cùng (nó giống như hình ảnh của các “bọt” khí nhẹ hơn được nổi lên trên). Tiếp theo tiến hành với các phần tử từ thứ 2 đến thứ n.

Procedure bubblesort(var amang; Ninteger);
begin
        var i,j integer;
        for i=2 to N do
        for j=N down to i do
        if (a[j]  a[j-1])
then
    hoanvi(a[j-1],a[j]);
end;

2. Selection Sort (Sắp xếp chọn)

Ý tưởng: Chọn phần tử nhỏ nhất trong n phần tử ban đầu, đưa phần tử này về vị trí đúng là đầu tiên của dãy hiện hành. Sau đó không quan tâm đến nó nữa, xem dãy hiện hành chỉ còn n-1 phần tử của dãy ban đầu, bắt đầu từ vị trí thứ 2. Lặp lại quá trình trên cho dãy hiện hành đến khi dãy hiện hành chỉ còn 1 phần tử. Dãy ban đầu có n phần tử, vậy tóm tắt ý tưởng thuật toán là thực hiện n-1 lượt việc đưa phần tử nhỏ nhất trong dãy hiện hành về vị trí đúng ở đầu dãy.

Các bước tiến hành như sau:
Bước 1: i=1
Bước 2: Tìm phần tử a[min] nhỏ nhất trong dãy hiện hành từ a[i] đến a[n]
Bước 3: Hoán vị a[min] và a[i]
Bước 4: Nếu i<=n-1 thì i=i+1; Lặp lại bước 2
Ngược lại: Dừng. n-1 phần tử đã nằm đúng vị trí.

Procedure seletionsort(var a:mang; N:byte);
var i,j: byte; min: integer;
begin
        for 1:=1 to N-1 do
        if (a[j] < a[min] then min:=j;
        if (min <> i) then hoanvi (a[min]; a[i];
end;

Procedure hoanvi(var x,y: integer);
var tam:integer
begin
        tam:=x
        x:=y
        y:=tam
end;

3. Insert Sort

Procedure insertionsort(var a:mang, N:byte);
begin
        var pos,i: byte; x:integer;
        for i:=2 to N do
        begin
            x:=a[i]; pos:=i;
{sap xep tang dan}
while (pos>1 and a[pos-1]>x)do
    begin
        a[pos]:= a[pos-1]; dec(pos);
    end;
    a[pos]:= x;
end;
{sap xep giam dan}
while (pos>1)
    begin
        if(a[pos-1] > x)then
    begin
        a[pos]:= a[pos-1]; dec(pos);
    end;
    a[pos]:= x;


4. QuickSort

procedure Quicksort ( Var A: Mang);
     Procedure Sort( Left, Right: Integer);
            Var
                     i, j, k: Integer;
               Begin
                     i:= Left;
                     j:= Right;
                     k:= A[(Left + Right) Div 2];
                     Repeat
                       While A[i] < k Do Inc(i);
                       While k < A[j] Do Dec(j);
                       If i <> j Then
                             Begin
                                     HoanVi(A[i],A[j]);
                                     Inc(i);
                                     Dec(j);
                             end;
                     Until i > j;
                             If Left < j Then Sort(Left,j);
                             If i < Right Then Sort(i,Right);
              end;
   Begin
          Sort(Left; Right);
   End;

Ebook Giải thuật và lập trình – Lê Minh Hoàng

Nếu bạn là người đam mê tin học, nếu bạn là người muốn khám phá về lập trình, hẳn bạn phải biết đến một cuốn sách tin học rất nổi tiếng ở Việt Nam trong nhiều năm trở lại đây. Từ những học sinh không chuyên đến những thành viên đội tuyển thi quốc tế tin học, có lẽ không một ai chưa từng học qua cuốn sách được biên soạn bởi một thầy giáo trẻ những đầy tài năng của trường Đại học Sư phạm Hà Nội, thầy Lê Minh Hoàng.

Mục lục:

PHẦN 1 – BÀI TOÁN LIỆT KÊ

• 1-Nhắc lại một số kiến thức đại số tổ hợp
• 2-Phương pháp sinh
• 3-Thuật toán quay lui
• 4-Kỹ thuật nhánh cận

PHẦN 2 – CẤU TRÚC DỮ LIỆU VÀ GIẢI THUẬT

• 1-Các bước cơ bản khi tiến hành giải các bài toán tin học
• 2-Phân tích thời gian thực hiện giải thuật
• 3-Đệ quy và giải thuật đệ quy
• 4-Cấu trúc dữ liệu biểu diễn danh sách
• 5-Ngăn xếp và hàng đợi
• 6-Cây
• 7-Ký pháp tiền tố, trung tố và hậu tố
• 8-Sắp xếp
• 9-Tìm kiếm

PHẦN 3 – QUY HOẠCH ĐỘNG

• 1-Công thức truy hồi
• 2-Phương pháp quy hoạch động
• 3-Một số bài toán quy hoạch động

PHẦN 4 – CÁC THUẬN TOÁN TRÊN ĐỒ THỊ

• 1-Các khái niệm cơ bản
• 2-Biểu diễn đồ thị trên máy tính
• 3-Các thuật toán tìm kiếm trên đồ thị
• 4-Tính liên thông của đồ thị
• 5-Vài ứng dụng của các thuật toán tìm kiếm trên đồ thị
• 6-Chu trình Euler, đường euler, đồ thị euler
• 7-Chu trình Hamilton, đường đi Hamilton, Đồ thị Hamilton
• 8-Bài toán đường đi ngắn nhất
• 9-Bài toán cây khung nhỏ nhất
• 10-Bài toán luồng cực đại trên mạng
• 11-Bài toán tìm bộ ghép cực đại trên đồ thị hai phía
• 12-Bài toán tìm bộ ghép cực đại với trọng số cực tiểu trên đồ thị hai phía – thuật toán Hungari
• 13-Bài toán tìm bộ ghép cực đại trên đồ thị

Tải về: Ebook Giải thuật và lập trình [pdf]
Hoặc xem online: Ebook giải thuật và lập trình - Upload by Codepascal.blogspot.com

Dãy Tribonacci

Dãy Tribonacci là dãy 1 , 1 , 2 , 3 , 7 , 13 , 24... dãy này được sinh ra bới công thức đệ qui sau :
Tr(1) = 1 , Tr(2) = 1 , Tr(3) = 2 , Tr(k) = Tr(k-1)+Tr(k-2)+Tr(k-3) ... với 3< k <37
Mọi số tự nhiên N đều có thể biểu diễn duy nhất dưới dạng tổng của một số số trong dãy Tribonacci.
VD: 17 = 13 + 4; 30 = 24 + 4 + 2;
Cho trước số tự nhiên N nhập từ bàn phím. Viết chương trình tìm biểu diễn Tribonacci của số N.

Ý tưởng: Xây dựng 1 mảng số Tribonacci từ 1 tới 37 (đến 37 vì theo đề bài ...), rồi duyệt từng phần tử của dãy Tribonacci, nếu n> Tribonacci[i] thì in ra Tribonacci[i] và giảm n tới khi n<0 thì thôi.

Uses crt;
Const
  max=37;
Var
  a:array[1..max] of longint;
  n,i:longint;
BEGIN
  Clrscr;
  a[1]:=1; a[2]:=1; a[3]:=2;
  For i:=4 to max do
    a[i]:=a[i-1]+a[i-2]+a[i-3];
  Write('Nhap so n:'); readln(n);
  i:=max;
  While a[i]>n do i:=i-1;
  Write(n,'=',a[i]);
  n:=n-a[i];
  While n>0 do
    Begin
      i:=i-1;
      If n>=a[i] then
        Begin
          Write('+',a[i]);
          n:=n-a[i];
        End;
    End;
  Readln;
END.

Số hoàn thiện

Một số có tỗng các ước nhỏ hơn nó bằng chính nó dc gọi là số hoàn chỉnh.VD 6 có ước nhỏ hơn nó là 1,2,3. Tổng là 1+2+3=6.Viết chương trình xét xem một số n dược nhập từ bàn phím có phải là số hoàn chỉnh không.
PROGRAM hoanthien;
VAR n:INTEGER;
FUNCTION kiemtra(x:INTEGER):BOOLEAN;
VAR tam,i:INTEGER;
BEGIN
tam:=0; kiemtra:=FALSE;
FOR i:= 1 TO (x DIV 2) DO
IF x MOD i = 0 THEN tam:=tam+i;
IF tam = x THEN kiemtra:=TRUE;
END;
BEGIN
writeln('Nhap so can kiem tra ');
readln(n);
IF kiemtra(n) THEN writeln('So ',n,' la so hoan thien')
ELSE
writeln('So ',n,' khong phai la so hoan thien');
readln;
END.