Giúp thuật toán tìm số xuất hiện nhiều nhất trong 1 dãy. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

chuot0106

Thành viên gắn bó
Tham gia
20/1/13
Bài viết
2,567
Được thích
1,671
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.
 
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.
Dùng Dictionary nạp hết các con số này vào. Nạp lần đầu thì cho Item = 1, lần xuất hiện tiếp theo thì Item+1. Khi xong rồi dùng Max để tìm item nào lớn nhất rồi lấy Key của nó ra. Tuy nhiên nếu có 2 số xuất hiện nhiều lần như nhau thì lấy số nào?
 
Dùng Dictionary nạp hết các con số này vào. Nạp lần đầu thì cho Item = 1, lần xuất hiện tiếp theo thì Item+1. Khi xong rồi dùng Max để tìm item nào lớn nhất rồi lấy Key của nó ra.
Cảm ơn anh nhưng thực ra em định hỏi thuật toán bài này sau đó dùng pascal để giải. Mong mọi người tiếp tục giúp đỡ. Nếu như cách anh đưa thì không biết đưa vào pascal ra sao?
Tuy nhiên nếu có 2 số xuất hiện nhiều lần như nhau thì lấy số nào?
Không biết có lấy được cả 2 số không anh?
 
Cảm ơn anh nhưng thực ra em định hỏi thuật toán bài này sau đó dùng pascal để giải. Mong mọi người tiếp tục giúp đỡ. Nếu như cách anh đưa thì không biết đưa vào pascal ra sao?

Không biết có lấy được cả 2 số không anh?
Mình có biết pascal là gì đâu mà dám có ý kiến ý cò.
Nếu dùng VBA thì kiểu gì cũng lấy ra được hết
 
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.

Lập trình chi cho mất công
=MODE(A1:A10) ---> Cho kết quả =3
Còn đếm số lần xuất hiện thì COUNTIF
----------------
Cảm ơn anh nhưng thực ra em định hỏi thuật toán bài này sau đó dùng pascal để giải.
Không biết trong Pascal có dùng được Dic không? Cứ cho là không, vậy thì ta cũng có thể dùng phép nối chuỗi, mỗi phần tử lấy vào sẽ nối với nhau thông qua 1 ký tự đặc biệt (để phân cách tránh nhầm). Sau đó dùng InStr để tìm xem có sự tồn tại của phần tử chuẩn bị đưa vào không, nếu có thì... làm gì đó tùy ý
 
Lần chỉnh sửa cuối:
Mình có biết pascal là gì đâu mà dám có ý kiến ý cò.
Nếu dùng VBA thì kiểu gì cũng lấy ra được hết
Pascal , VBA hay C++,... thì nó cũng chỉ là công cụ thực để giải quyết các bài toán cụ thể thôi mà anh. Nếu có thuật toán thì em nghĩ dùng công cụ nào cũng giải quyết được hết ạ!

Lập trình chi cho mất công
=MODE(A1:A10) ---> Cho kết quả =3
Còn đếm số lần xuất hiện thì COUNTIF
Thực ra em muốn nhờ mọi người trên GPE giúp đỡ thuật toán sau đó em chuyển qua pascal để làm thầy ạ.
 
Chỉnh sửa lần cuối bởi điều hành viên:
bạn code thử như vậy xem sao? nếu code không đuợc tôi sẽ giúp.
bạn viết 1 function để tìm số lần xuất hiện của 1 số là bao nhiêu lần(số cần kiểm tra là 1 tham trị)
hàm main bạn cho duyệt từ đầu dãy cho tới cuối dãy.cứ mỗi số là gọi lại hàm tìm số lần xuất hiện rồi so sánh với nhau xem số nào xuất hiện nhiều lần nhất rồi đưa ra đáp số( hàm main này bạn sử dụng thuật toán tìm max kỹ thuật sử dụng lính canh là ok)
 
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.

Đây là bài toán tin lập trình cơ bản : Số phần tử, tìm max, cờ chặn.... (1 thủ tục cũng có thể giải quyết xong). Hôm trước thấy bạn nói em bạn thi TIN HỌC TRẺ, .. vậy chỉ cần hỏi em bạn là xong, bài này chắc chắn em ấy biết, đâu phải hỏi xa
 
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.
Lâu lắm không đụng Pascal rồi, nhưng có lẽ là thế này chăng:
1. Khai báo 2 mảng:
Arr1: Array[1 to 10] of Integer; Arr2: [1 to 10, 1 to 2] of Integer; (số 10 có thể thay bởi 1 hằng số trước đó)
Trong đó, Arr1 là mảng chứa dữ liệu đầu vào, Arr2 là mảng ghi nhận số lần xuất hiện của các giá trị trong mảng Arr1.

2. Duyệt từ đầu đến cuối mảng Arr1 và ghi số lần xuất hiện các giá trị vào mảng Arr2 (mảng Arr2 có 2 "cột", "cột" 1 chứa giá trị và "cột" 2 chứa số lần xuất hiện của giá trị đó, kiểu như bảng phân bố tần số trong thống kê vậy). Có thể sẽ không dùng đến cả 10 "hàng" mà chỉ dùng đến k "hàng" thôi (k<=10)

3. Duyệt mảng Arr2 (chỉ cần đến k "hàng" thôi), dựa vào Max của "cột" 2 để lấy ra giá trị tương ứng ở "cột" 1. Giá trị này chính là giá trị cần tìm.
 
Lần chỉnh sửa cuối:
bạn code thử như vậy xem sao? nếu code không đuợc tôi sẽ giúp.
bạn viết 1 function để tìm số lần xuất hiện của 1 số là bao nhiêu lần(số cần kiểm tra là 1 tham trị)
hàm main bạn cho duyệt từ đầu dãy cho tới cuối dãy.cứ mỗi số là gọi lại hàm tìm số lần xuất hiện rồi so sánh với nhau xem số nào xuất hiện nhiều lần nhất rồi đưa ra đáp số( hàm main này bạn sử dụng thuật toán tìm max kỹ thuật sử dụng lính canh là ok)
Nếu vậy mỗi lần tìm đếm số lần xuất hiện sẽ phải dùng mảng để lưu giá trị đó vào rồi mới có thể so sánh được đúng không bạn?

Đây là bài toán tin lập trình cơ bản : Số phần tử, tìm max, cờ chặn.... (1 thủ tục cũng có thể giải quyết xong). Hôm trước thấy bạn nói em bạn thi TIN HỌC TRẺ, .. vậy chỉ cần hỏi em bạn là xong, bài này chắc chắn em ấy biết, đâu phải hỏi xa
Đây là bài của thằng em nó hỏi mình đó bạn! Nó cũng chưa nghĩ ra cách giải. Nó mới học lớp 8 thôi.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Function solanxuathien(rngs As Range, n As Long) As Byte
Dim solan As Byte
Dim cll As Range
solan = 0
For Each cll In rngs
If (cll.Value = n) Then
solan = solan + 1
End If
Next
solanxuathien = solan
End Function


Function So_Xuat_hien_nhieu(rngs As Range) As Byte
Dim dem As Byte
Dim max As Byte
Dim cll As Range
dem = 0
max = 0
For Each cll In rngs
If (dem < solanxuathien(rngs, cll.Value)) Then
dem = solanxuathien(rngs, cll.Value)
max = cll.Value
End If
Next
So_Xuat_hien_nhieu = max
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
Đây là bài của thằng em nó hỏi mình đó bạn! Nó cũng chưa nghĩ ra cách giải. Nó mới học lớp 8 thôi.

Vậy hãy tập hợp các ý trên, và nói nó hãy suy nghĩ đơn giản từng bước, nếu tự ta làm ngoài giấy làm sao (tìm số xuất hiện nhiều bằng bút, giấy với dãy số 100 số chẳng hạn), thì từ đó mới hình dung lập trình như thế, phải tập tư duy thế, thì mới quen dần và thi được. Đọc các ví dụ khác nữa, từ đó đưa ra cách làm của riêng mình, rồi mang lại đây hỏi.

Còn nếu chỉ luôn cách đầy đủ, thì hôm sau gặp bài khác chút lại tắc tỵ, tập thế sẽ quen dần và vào thi không choáng.
 
Lâu lắm không đụng Pascal rồi, nhưng có lẽ là thế này chăng:
1. Khai báo 2 mảng:
Arr1: Array[1 to 10] of Integer; Arr2: [1 to 10, 1 to 2] of Integer; (số 10 có thể thay bởi 1 hằng số trước đó)
Trong đó, Arr1 là mảng chứa dữ liệu đầu vào, Arr2 là mảng ghi nhận số lần xuất hiện của các giá trị trong mảng Arr1.

2. Duyệt từ đầu đến cuối mảng Arr1 và ghi số lần xuất hiện các giá trị vào mảng Arr2 (mảng Arr2 có 2 "cột", "cột" 1 chứa giá trị và "cột" 2 chứa số lần xuất hiện của giá trị đó, kiểu như bảng phân bố tần suất trong thống kê vậy). Có thể sẽ không dùng đến cả 10 "hàng" mà chỉ dùng đến k "hàng" thôi (k<=10)

3. Duyệt mảng Arr2 (chỉ cần đến k "hàng" thôi), dựa vào Max của "cột" 2 để lấy ra giá trị tương ứng ở "cột" 1. Giá trị này chính là giá trị cần tìm.
Thuật toán của anh thì em hiểu nhưng bài này không dùng mảng 2 chiều được vì sử dụng kiến thức chương trình pascal 8 thôi anh ạ. Lớp 8 các em nó mới học mảng 1 chiều thôi. Khó khăn thật đó.
 
bài này là dạng bài tập duyệt trên mảng 1 chiều thôi
 
Function solanxuathien(rngs As Range, n As Long) As Byte
Dim solan As Byte
Dim cll As Range
solan = 0
For Each cll In rngs
If (cll.Value = n) Then
solan = solan + 1
End If
Next
solanxuathien = solan
End Function
Function So_Xuat_hien_nhieu(rngs As Range) As Byte
Dim dem As Byte
Dim max As Byte


Dim cll As Range
dem = 0
max = 0
For Each cll In rngs
If (dem < solanxuathien(rngs, cll.Value)) Then
dem = solanxuathien(rngs, cll.Value)
max = cll.Value
End If
Next
So_Xuat_hien_nhieu = max
End Function
Hàm của anh chính xác rồi. Anh có biết pascal không ạ? Nếu biết mong anh chuyển giúp em qua ngôn ngữ này với ạ!
 
Bạn thử code sau, 20 năm rồi không sờ đến Pascal nên không rõ có chính xác không, nhất là chỗ Exit để thoát vòng lặp For, nếu kết quả không đúng thì dùng Goto ra ngoài (nhưng Pascal không khuyến khích).
Mã:
Var   i, j, k:integer;
         a, b: array [1..10] of integer;
Begin
    max:=1;
    k:=1;
    b[1]:=1;
    Readln(a[1]);
    For i:=2 to 10 do
      Begin
         Readln(a[i]);
         For j:=i-1 downto 1 do
             Begin
                 If  a[i]=a[j] then
                   Begin
                     b[i]:=b[j]+1;
                     Exit;
                   End;
                  b[i]:=1;
             End;
          If b[i]>max then
             Begin
                 max:=b[i];
                 k:=i;
             End;
        End;
  Writeln(a[k],max);
End.
 
Lần chỉnh sửa cuối:
Bạn thử code sau, 20 năm rồi không sờ đến Pascal nên không rõ có chính xác không, nhất là chỗ Exit để thoát vòng lặp For, nếu kết quả không đúng thì dùng Goto ra ngoài (nhưng Pascal không khuyến khích).
Mã:
Var   i, j, k:integer;
         a, b: array [1..10] of integer;
Begin
    max:=1;
    k:=1;
    b[1]:=1;
    Readln(a[1]);
    For i:=2 to 10 do
      Begin
         Readln(a[i]);
         For j:=i-1 downto 1 do
             Begin
                 If  a[i]=a[j] then
                   Begin
                     b[i]:=b[j]+1;
                     Exit;
                   End[COLOR=#ff0000][B];[/B][/COLOR]
                Else b[i]:=1;
             End;
          If b[i]>max then
             Begin
                 max:=b[i];
                 k:=i;
             End;
        End;
  Writeln(a[k],max);
End.
Cảm ơn bạn nhiều! Tôi Test thử luôn xem sao? Mà hình như trước Else không có dấu ";" bạn ạ.
 
Bạn thử code sau, 20 năm rồi không sờ đến Pascal nên không rõ có chính xác không, nhất là chỗ Exit để thoát vòng lặp For, nếu kết quả không đúng thì dùng Goto ra ngoài (nhưng Pascal không khuyến khích).
Mã:
Var   i, j, k:integer;
         a, b: array [1..10] of integer;
Begin
    max:=1;
    k:=1;
    b[1]:=1;
    Readln(a[1]);
    For i:=2 to 10 do
      Begin
         Readln(a[i]);
         For j:=i-1 downto 1 do
             Begin
                 If  a[i]=a[j] then
                   Begin
                     b[i]:=b[j]+1;
                     Exit;
                   End;
                  b[i]:=1;
             End;
          If b[i]>max then
             Begin
                 max:=b[i];
                 k:=i;
             End;
        End;
  Writeln(a[k],max);
End.
Bạn xem lại hộ tôi với. trong chương trình bạn viết nếu tôi bỏ lệnh exit đi thì nó in ra số xuất hiện nhiều nhất nhưng số lần xuất hiện thì nó in sai luôn cho kết quả là 1.
 
Mình đã test thử, mình khai báo thêm biến Max nữa. Chương trình đã chạy nhưng không thấy in kết quả bạn ạ! Mình thêm cả lệnh readln; nữa mà vẫn không được.
Đúng là mình quên khai báo biến max nhưng tại sao không in ra kết quả nhỉ? Lệnh cuối cùng dùng để in ra a[k] là số xuất hiện nhiều nhất và max là số lần xuất hiện a[k] mà?
 
Đúng là mình quên khai báo biến max nhưng tại sao không in ra kết quả nhỉ? Lệnh cuối cùng dùng để in ra a[k] là số xuất hiện nhiều nhất và max là số lần xuất hiện a[k] mà?
Bỏ lệnh exit đi là nó in bạn ạ. Nhưng nó chỉ in số xuất hiện nhiều nhất thôi. Còn số lần xuất hiện thì nó in sai bạn ạ!

Bạn thử code sau, 20 năm rồi không sờ đến Pascal nên không rõ có chính xác không, nhất là chỗ Exit để thoát vòng lặp For, nếu kết quả không đúng thì dùng Goto ra ngoài (nhưng Pascal không khuyến khích).
Mã:
Var   i, j, k:integer;
         a, b: array [1..10] of integer;
Begin
    max:=1;
    k:=1;
    b[1]:=1;
    Readln(a[1]);
    For i:=2 to 10 do
      Begin
         Readln(a[i]);
         For j:=i-1 downto 1 do
             Begin
                 If  a[i]=a[j] then
                   Begin
                     b[i]:=b[j]+1;
                     Exit;
                   End;
                  b[i]:=1;
             End;
          If b[i]>max then
             Begin
                 max:=b[i];
                 k:=i;
             End;
        End;
  Writeln(a[k],max);
End.
Bạn có thể nói qua thuật toán của bạn được không. Để tôi thử sửa lại xem sao?
 
Chỉnh sửa lần cuối bởi điều hành viên:
Bạn xem lại hộ tôi với. trong chương trình bạn viết nếu tôi bỏ lệnh exit đi thì nó in ra số xuất hiện nhiều nhất nhưng số lần xuất hiện thì nó in sai luôn cho kết quả là 1.
Lệnh exit không bỏ được, mục đích của code mình viết là tạo mảng b[1..10] như sau nếu mảng a = 1, 1, 1, 2, 1, 2 thì mảng
b= 1, 2, 3, 1, 4, 2. Khi lặp j từ i-1 đến 1 nếu a=a[j] thì gán b:=b[j]+1 sau đó exit for luôn, nếu không exit thì b sẽ được gán thành b[1]=1. Nếu không dùng exit thì thay bằng goto thoát, nhãn "thoat' này phải đặt ngoài vòng lặp
for j:=i-1 down to 1 để thoát khỏi vòng lặp.
Mã:
Label thoat;
Var   i, j, k, max:integer;
         a, b: array [1..10] of integer;
Begin
    max:=1;
    k:=1;
    b[1]:=1;
    Readln(a[1]);
    For i:=2 to 10 do
      Begin
         Readln(a[i]);
         For j:=i-1 downto 1 do
             Begin
                 If  a[i]=a[j] then
                   Begin
                     b[i]:=b[j]+1;
                     Goto thoat;
                   End;
               b[i]:=1;
             End;
          thoat: If b[i]>max then
             Begin
                 max:=b[i];
                 k:=i;
             End;
        End;
  Writeln(a[k],max);
End.
 
Lần chỉnh sửa cuối:
Lệnh exit không bỏ được, mục đích của code mình viết là tạo mảng b[1..10] như sau nếu mảng a = 1, 1, 1, 2, 1, 2 thì mảng
b= 1, 2, 3, 1, 4, 2. Khi lặp j từ i-1 đến 1 nếu a=a[j] thì gán b:=b[j]+1 sau đó exit for luôn, nếu không exit thì b sẽ được gán thành b[1]=1. Nếu không dùng exit thì thay bằng goto thoát, nhãn "thoat' này phải đặt ngoài vòng lặp
for j:=i-1 down to 1 để thoát khỏi vòng lặp.

Vậy tại sao chương trình lại không in kết quả nhỉ.

Lệnh exit không bỏ được, mục đích của code mình viết là tạo mảng b[1..10] như sau nếu mảng a = 1, 1, 1, 2, 1, 2 thì mảng
b= 1, 2, 3, 1, 4, 2. Khi lặp j từ i-1 đến 1 nếu a=a[j] thì gán b:=b[j]+1 sau đó exit for luôn, nếu không exit thì b sẽ được gán thành b[1]=1. Nếu không dùng exit thì thay bằng goto thoát, nhãn "thoat' này phải đặt ngoài vòng lặp
for j:=i-1 down to 1 để thoát khỏi vòng lặp.

Được rồi bạn ạ. Tôi thay lệnh exit; bằng lệnh Break; là OK luôn. Bạn có pascal không thử luôn xem!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Được rồi bạn ạ. Tôi thay lệnh exit; bằng lệnh Break; là OK luôn. Bạn có pascal không thử luôn xem!
Mình không có Pascal, mà bạn dùng Pascal gì? Mình viết theo cú pháp của Turbo Pascal, ngày xưa học vẫn nhớ lệnh exit. Có thể bạn dùng Pascal khác chăng?
 
Gởi chuot,
Bạn không nên viết 1 lần 2, 3 bài liên tục, tôi đã phải gộp 2 thành 1 ít nhất là 4 lần trong topic này, và nhiều lần ở những topic khác. Hãy nghĩ kỹ tất cả những gì cần viết và viết 1 bài, cho xứng đáng 1 bài có ý nghĩa.
Ngoài ra, chỉ cần trích dẫn vừa đủ ý muốn trích, và vừa đủ để biết đang trả lời ai, đừng trích dài thậm thượt rồi viết chỉ 1 câu cụt lủn.
 
Lần chỉnh sửa cuối:
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.


Nghe giúp em bạn, vậy thì coi như là VD mẫu cho nó học đi,

Ở đây tôi tạm bỏ qua phần nhập liệu nhé --> em bạn chắc làm tốt (có thể nhập từ bàn phím hay file gì đó, ở đây gán trực tiếp), cơ bản như sau (program sau đảm bảo chạy và đúng thuật toán cơ bản)
Mã:
program VD_day1;
var
  i,j,n,maxd,d,id: integer;
  a: array[1..10] of integer;
begin
  n:=10;

  a[1]:=30; a[2]:=4;  a[3]:=5;  a[4]:=30; a[5]:=7;
  a[6]:=4;  a[7]:=30; a[8]:=5;  a[9]:=7;  a[10]:=30;

  maxd:=0;
  for i:=1 to n-1 do
    begin
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then d:=d+1;

     if d>maxd then
      begin  maxd:=d;    id:=i;  end
    end;
  writeln('Ket qua la so lap nhieu la ', a[id], ' so lan = ',maxd);
  readln;
end.

Còn trường hợp liệt kê hết các số có "số lần xuất hiện nhiểu nhất bằng nhau" thì để em bạn tự phát triển xem sao,
 
Lần chỉnh sửa cuối:
Nghe giúp em bạn, vậy thì coi như là VD mẫu cho nó học đi,

Ở đây tôi tạm bỏ qua phần nhập liệu nhé --> em bạn chắc làm tốt (có thể nhập từ bàn phím hay file gì đó, ở đây gán trực tiếp), cơ bản như sau (program sau đảm bảo chạy và đúng thuật toán cơ bản)
Mã:
program VD_day1;
var
  i,j,n,maxd,d,id: integer;
  a: array[1..10] of integer;
begin
  n:=10;

  a[1]:=30; a[2]:=4;  a[3]:=5;  a[4]:=30; a[5]:=7;
  a[6]:=4;  a[7]:=30; a[8]:=5;  a[9]:=7;  a[10]:=30;

  maxd:=0;
  for i:=1 to n-1 do
    begin
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then d:=d+1;

     if d>maxd then
      begin  maxd:=d;    id:=i;  end
    end;
  writeln('Ket qua la so lap nhieu la ', a[id], ' so lan = ',maxd);
  readln;
end.

Còn trường hợp liệt kê hết các số có "số lần xuất hiện nhiểu nhất bằng nhau" thì để em bạn tự phát triển xem sao,
Rất cảm ơn bạn, thuật toán của bạn kết quả cũng chính xác luôn, đặc biệt rất dễ hiểu.
P/s: Một lần nữa cảm ơn tất cả các bạn đã bỏ công sức giúp đỡ tôi!!!
 
Rất cảm ơn bạn, thuật toán của bạn kết quả cũng chính xác luôn, đặc biệt rất dễ hiểu.
P/s: Một lần nữa cảm ơn tất cả các bạn đã bỏ công sức giúp đỡ tôi!!!

Đừng vội bằng lòng; THI thì cần phải thuật toán tối ưu hơn, tham khảo cái này cho phức tạp hơn chút

Mã:
program VD_day1b;
uses crt;
var
  i,j,n,maxd,d,id: integer;
  a,b: array[1..10] of integer;
begin
  clrscr;

  n:=10;
  a[1]:=30; a[2]:=4;  a[3]:=5;  a[4]:=30; a[5]:=7;
  a[6]:=4;  a[7]:=30; a[8]:=5;  a[9]:=7;  a[10]:=30;

  fillchar(b,sizeof(b),0);
  maxd:=0;
  for i:=1 to n-1 do
    if b[i]=0 then
    begin
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then
          begin d:=d+1; b[i]:=1 end;

     if d>maxd then
      begin  maxd:=d;    id:=i;  end
    end;

  writeln('Ket qua la so lap nhieu la: a[',id,']= ', a[id], '   voi so lan lap= ',maxd);
  readln;
end.

trường hợp mở rộng liệt kê tất cả , vẫn để cho em ấy tự phát triển

(chú ý là thi thì những bài này thì thuộc loại thường thường vì thi người ta đòi hỏi tư duy thuật toán , nên cần nói em bạn ôn tập kỹ sâu hơn nữa)
 
Lần chỉnh sửa cuối:
Nếu số của bạn là số nguyên thì theo nghề lập trinh, bài này thuộc loại "mảng tính chỉ số trực tiếp". Tức là bạn tạo một mảng thật lớn, số phần tử lớn hơn hoặc bằng số lớn nhất trong chuỗi số.
Như vậy, mỗi trị số trong chuỗi sẽ ứng với chỉ số của một phần tử trong mảng kia.
Đọc chuỗi, dùng trị để chiếu đến mảng, và tăng số đếm lên 1; đồng thời ghi trị số đếm max là ở chỉ số này. Cứ mỗi trị kế tiếp trong chuỗi thì lại dò lên mảng để cộng 1 và so sánh nó với phần tử đang có số đếm max.
Thuật toán chỉ số trực tiếp là căn bản lập trình. Tại quý vị quen dùng nhiều tiện nghi của vba (như dictionary) nên bỏ qua phần căn bản thôi.
 
Nếu số của bạn là số nguyên thì theo nghề lập trinh, bài này thuộc loại "mảng tính chỉ số trực tiếp". Tức là bạn tạo một mảng thật lớn, số phần tử lớn hơn hoặc bằng số lớn nhất trong chuỗi số.
Như vậy, mỗi trị số trong chuỗi sẽ ứng với chỉ số của một phần tử trong mảng kia.
Đọc chuỗi, dùng trị để chiếu đến mảng, và tăng số đếm lên 1; đồng thời ghi trị số đếm max là ở chỉ số này. Cứ mỗi trị kế tiếp trong chuỗi thì lại dò lên mảng để cộng 1 và so sánh nó với phần tử đang có số đếm max.
Thuật toán chỉ số trực tiếp là căn bản lập trình. Tại quý vị quen dùng nhiều tiện nghi của vba (như dictionary) nên bỏ qua phần căn bản thôi.

Đúng thế, rời Dic to Dic nhỏ là chít sặc ngay, bản chất trong Dic cũng xây lên từ những cái cơ bản này, có chăng giờ hiện đại toàn dùng công cụ to, có nhà sản xuất lo.

bài này thuộc thuật toán dò tim, đếm, max cơ bản

@chuot...: xem lại bài #30 có thuật toán tối ưu hơn
 
Lần chỉnh sửa cuối:
Đừng vội bằng lòng; THI thì cần phải thuật toán tối ưu hơn, tham khảo cái này cho phức tạp hơn chút

Mã:
program VD_day1b;
uses crt;
var
  i,j,n,maxd,d,id: integer;
  a,b: array[1..10] of integer;
begin
  clrscr;

  n:=10;
  a[1]:=30; a[2]:=4;  a[3]:=5;  a[4]:=30; a[5]:=7;
  a[6]:=4;  a[7]:=30; a[8]:=5;  a[9]:=7;  a[10]:=30;

  fillchar(b,sizeof(b),0);
  maxd:=0;
  for i:=1 to n-1 do
    if b[i]=0 then
    begin
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then
          begin d:=d+1; b[i]:=1 end;

     if d>maxd then
      begin  maxd:=d;    id:=i;  end
    end;

  writeln('Ket qua la so lap nhieu la: a[',id,']= ', a[id], '   voi so lan lap= ',maxd);
  readln;
end.

trường hợp mở rộng liệt kê tất cả , vẫn để cho em ấy tự phát triển

(chú ý là thi thì những bài này thì thuộc loại thường thường vì thi người ta đòi hỏi tư duy thuật toán , nên cần nói em bạn ôn tập kỹ sâu hơn nữa)
Trời bài này mà bạn vẫn cho là "thường thường" thôi sao? À quên tôi chưa nói rõ, thẳng em của tôi nó thi tin học trẻ không chuyên do bộ công an tổ chức cho con em trong nghành thi với nhau thôi chứ không phải thi "chuyên" nên những bài này mình nghĩ cũng là khó rồi đó!

P/S: Cho tôi hỏi thêm là chương trình sau này dùng thêm mảng b thì có tốt hơn không vậy? Chương trình trước tôi thấy ổn lắm rồi mà. Tôi thấy bạn và bạn Hau151978 có vẻ chắc về pascal thật đấy, nếu các bạn có bài tập Pascal thì gửi tôi xin 1 ít.
 
Lần chỉnh sửa cuối:
....
P/S: Cho tôi hỏi thêm là chương trình sau này dùng thêm mảng b thì có tốt hơn không vậy? Chương trình trước tôi thấy ổn lắm rồi mà. Tôi thấy bạn và bạn Hau151978 có vẻ chắc về pascal thật đấy, nếu các bạn có bài tập Pascal thì gửi tôi xin 1 ít.

Chắc chắn là tốt hơn và tiết kiệm đi số vòng lặp không đáng có (đối với các số giống nhau đã xét, ví như số 30, chỉ xét lần 1 gặp mà thôi, còn lần sau thì bỏ qua, không cần phải lặp với for j )-- tại sao thế thì nên để cho em bạn tự đọc code và rút ra thì hay hơn.

về bài tập bạn tự tìm trên mạng, các sách nâng cao, sách thuật toán đầy ở thị trường, ở thư viện. Sợ không làm hết được thôi.

Cuộc thi nào thì cũng phải có những bài toán đáng mặt chọn người giỏi, nên những bài thế này e rằng là mức bình bình trong các cuộc thi - tuy vậy cái đó thì em bạn và thầy của em ấy sẽ biết.
 
Pascal lâu lắm rồi mình không sờ đến nên quên hết rồi, bài tập hay tài liệu cũng không có. Mình thấy bài này về thuật toán là cơ bản, bạn quen VB rồi thì lập trình bằng VB trước sau đó giải thích thuật toán cho cậu em để nó viết bằng Pascal. Code của mình nếu viết bằng VBA sẽ là:
Mã:
Sub main()
Dim a(1 To 10) As Integer, b(1 To 10) As Integer, i As Integer, j As Integer, k As Integer, maxx As Integer
a(1) = Range("a" & 1)
b(1) = 1
maxx = 1
k = 1
For i = 2 To 10
a(i) = Range("a" & i)
b(i) = 1
For j = i - 1 To 1 Step -1
If a(j) = a(i) Then
b(i) = b(j) + 1
Exit For
End If
Next
If b(i) > maxx Then
maxx = b(i)
k = i
End If
Next
[B1] = maxx
[B2] = a(k)
End Sub
 
Cũng tham gia 2 cái vòng lặp cho chủ thớt tham khảo. Code đơn giản dễ hiểu
Không xài dictionary thì dễ thấy cách vận hành của code. Nhưng mà nếu dữ liệu nhiều thì chắc hơi oải vì cứ For Next hoài
Trước lúc biết Dic mình toàn nhai thế này.
PHP:
Sub abc()
Dim data(), i, j, n, giatri, solan
data = [A1:A10].Value
For i = 1 To UBound(data)
    For j = 1 To UBound(data)
        If data(i, 1) = data(j, 1) Then n = n + 1
        If n > solan Then
            solan = n
            giatri = data(i, 1)
            Exit For
        End If
    Next
    n = 0
Next
MsgBox giatri & " xuat hien " & solan
End Sub
 
Lần chỉnh sửa cuối:
Đừng vội bằng lòng; THI thì cần phải thuật toán tối ưu hơn, tham khảo cái này cho phức tạp hơn chút

Mã:
program VD_day1b;
uses crt;
var
  i,j,n,maxd,d,id: integer;
  a,b: array[1..10] of integer;
begin
  clrscr;

  n:=10;
  a[1]:=30; a[2]:=4;  a[3]:=5;  a[4]:=30; a[5]:=7;
  a[6]:=4;  a[7]:=30; a[8]:=5;  a[9]:=7;  a[10]:=30;

  fillchar(b,sizeof(b),0);
  maxd:=0;
  for i:=1 to n-1 do
    if b[i]=0 then
    begin
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then
          begin d:=d+1; b[i]:=1 end;

     if d>maxd then
      begin  maxd:=d;    id:=i;  end
    end;

  writeln('Ket qua la so lap nhieu la: a[',id,']= ', a[id], '   voi so lan lap= ',maxd);
  readln;
end.

trường hợp mở rộng liệt kê tất cả , vẫn để cho em ấy tự phát triển

(chú ý là thi thì những bài này thì thuộc loại thường thường vì thi người ta đòi hỏi tư duy thuật toán , nên cần nói em bạn ôn tập kỹ sâu hơn nữa)

Bài này , giờ mới ngó lại, đúng là đêm khuya nhầm lần (tuy kết quả không sai, nhưng số vòng lặp không được giảm)

đoạn này
Mã:
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then
          begin d:=d+1; b[[COLOR=#ff0000]i[/COLOR]]:=1 end;

thay b[ i ] thành b[ j ] , như sau
Mã:
     d:=1;
     for j:=i+1 to n  do
        if a[i]=a[j] then
          begin d:=d+1; b[[COLOR=#0000ff]j[/COLOR]]:=1 end;

như thế mới đúng ý đồ thuật toán, là cắt bớt vòng "for j ..." lặp các số giống nhau đã xét

sorry về sự nhầm lẫn này, vậy chuot0106 sửa lại nhé
 
Lần chỉnh sửa cuối:
Cũng tham gia 2 cái vòng lặp cho chủ thớt tham khảo. Code đơn giản dễ hiểu
Không xài dictionary thì dễ thấy cách vận hành của code. Nhưng mà nếu dữ liệu nhiều thì chắc hơi oải vì cứ For Next hoài
Trước lúc biết Dic mình toàn nhai thế này.
PHP:
Sub abc()
Dim data(), i, j, n, giatri, solan
data = [A1:A10].Value
For i = 1 To UBound(data)
    For j = 1 To UBound(data)
        If data(i, 1) = data(j, 1) Then n = n + 1
        If n > solan Then
            solan = n
            giatri = data(i, 1)
            Exit For
        End If
    Next
    n = 0
Next
MsgBox giatri & " xuat hien " & solan
End Sub
Đã chuyển thuật toán của anh quanghai1969 sang pascal và đã thành công! Em cảm ơn anh nhiều ạ!
 
Cho a là mảng chứa các số nguyên dương từ 0 đến N.
Lý thuyết thuật toán:
Lập cnt là mảng N+1 phần tử (0 to N). Trị của phần tử cnt(n) là số lần xuất hiện của n trong a.

Mã:
Option Explicit


Sub t1()
[COLOR=#006400]' hàm tìm số xuất hiện nhiều lần nhất trong một mảng A1:A100
' nếu có nhiều số đồng hạng thì số tiến tới max trước sẽ được ưu tiên[/COLOR]
Dim a As Variant
a = Application.Transpose(Range("a1:a100"))
Dim i As Integer, mde As Integer
Dim cnt(0 To 100000) As Integer
mde = 0
For i = 1 To UBound(a)
    cnt(a(i)) = cnt(a(i)) + 1
    If cnt(a(i)) > cnt(mde) Then mde = a(i)[COLOR=#006400] ' ghi lại số có số lần nhiều nhất[/COLOR]
Next i
MsgBox "value: " & mde & "; times: " & cnt(mde)
End Sub


Sub t2()
[COLOR=#006400]' hàm tìm số xuất hiện nhiều lần nhất trong một mảng A1:A100
' nếu có nhiều số đồng hạng thì sé được một mảng[/COLOR]
Dim a As Variant
a = Application.Transpose(Range("a1:a100"))
Dim i As Integer, lm As Integer
Dim ans As String
Dim cnt(0 To 100000) As Integer, mde(0 To 100000) As Integer
[COLOR=#006400]'    mde là mảng chứa các số có lần xuất hiện nhiều nhất
'    lm là phần tử cuối cùng trong mảng mde[/COLOR]
[COLOR=#006400]l[/COLOR]m = 0
mde(lm) = a(LBound(a))
For i = LBound(a) To UBound(a)
[COLOR=#006400]  ' nếu số mới nhiều hơn các số trong mảng kết quả thì nó trở thành số độc tôn
  ' nếu chỉ bằng các số trong mảng kết quả thì nhét thêm nó vào
  ' nếu ít hơn thì bỏ qua[/COLOR]
  If cnt(a(i)) + 1 >= cnt(mde(lm)) Then
    If cnt(a(i)) = cnt(mde(lm)) Then
        lm = 0
    Else
        lm = lm + 1
    End If
    mde(lm) = a(i)
  End If
  cnt(a(i)) = cnt(a(i)) + 1
Next i
[COLOR=#006400]'   đến đây thì mde(0) --> mde(lm) là các trị xuất hiện nhiều nhất
[/COLOR]ans = ""
For i = 0 To lm
    ans = ans & vbLf & "value: " & mde(i) & "; times: " & cnt(mde(i))
Next i
MsgBox ans
End Sub
 
tìm tần suất

var
a,b:array[1..1000000] of longint;
n,i,max: longint;
begin
read(n); // đọc vào số phần tử trong mảng
for i:=1 to n do read(a);
fillchar(b,sizeof(b),0); //tạo mảng b có toàn phần tử có giá trị bằng 0
for i:=1 to n do inc(b[a]);// đếm xem mỗi phần tử trong mảng a xuất hiện bao nhiêu lần
max:=0; // gán giá trị lớn nhất bằng 0 để so sánh
for i:=1 to n do
if b> max then max:=b; // tìm số lần xuất hiện nhiều nhất;
for i:=1 to n do
begin
if b= max then break;// tìm lại xem số xuất hiện nhiều nhất là bao nhiêu tìm được rồi thì dừng lại
end;
write(i,' ',max);
end.

với cách làm này thì ko thể chạy quá thời gian đối vs những test cỡ lớn đc ạ vì e học chuyên tin nên mấy bài này cũng làm rồi nên cũng khá chắc chắn.
 
var
a,b:array[1..1000000] of longint;
n,i,max: longint;
begin
read(n); // đọc vào số phần tử trong mảng
for i:=1 to n do read(a);
fillchar(b,sizeof(b),0); //tạo mảng b có toàn phần tử có giá trị bằng 0
for i:=1 to n do inc(b[a]);// đếm xem mỗi phần tử trong mảng a xuất hiện bao nhiêu lần
max:=0; // gán giá trị lớn nhất bằng 0 để so sánh
for i:=1 to n do
if b> max then max:=b; // tìm số lần xuất hiện nhiều nhất;
for i:=1 to n do
begin
if b= max then break;// tìm lại xem số xuất hiện nhiều nhất là bao nhiêu tìm được rồi thì dừng lại
end;
write(i,' ',max);
end.

với cách làm này thì ko thể chạy quá thời gian đối vs những test cỡ lớn đc ạ vì e học chuyên tin nên mấy bài này cũng làm rồi nên cũng khá chắc chắn.


Em học chuyên tin dở bẹt.
Theo thuật toán của em thì phải duyệt mảng ít nhất 2 lần (trung bình là 2,5 lần), môt lần cộng tầng số, mọt lần duyệt lấy tầng số cao nhất, và một lần tìm trị (tuy lần này có thể thoát sớm, có thể coi như 0,5 trung bình)
 
Nếu các phần tử của mảng là số nguyên dương thì làm như bài #39 có lẽ là cách tốt nhất. Nếu không bạn có thể tham khảo code sau.
PHP:
Sub TanXuat()
Dim Data As Variant, i As Long, j As Long, n As Long, ViTriCuoi As Long, GiaTri, SoLan As Long
Data = [A1:A100].Value
ViTriCuoi = UBound(Data, 1)
Do While i < ViTriCuoi
    i = i + 1:    j = i + 1:    n = 1
    Do Until j > ViTriCuoi
        If Data(i, 1) = Data(j, 1) Then
            n = n + 1
            Data(j, 1) = Data(ViTriCuoi, 1)
            ViTriCuoi = ViTriCuoi - 1
        Else
            j = j + 1
        End If
    Loop
    If n > SoLan Then
        GiaTri = Data(i, 1)
        SoLan = n
    End If
Loop
MsgBox GiaTri & " xuat hien nhieu nhat voi " & SoLan & " lan"
End Sub
 
Giả sử tôi có 1 dãy số từ A1 đến A10 như sau:
3 4 5 3 7 4 3 5 7 3
Tôi muốn nhờ các thành viên giúp tôi thuật toán để có thể tìm ra số xuất hiện nhiều nhất trong dãy và cả số lần xuất hiện của nó nữa với. Cụ thể ở ví dụ này là số xuất hiện nhiều nhất là 3, số lần xuất hiện là 4.
Vẫn bài này nhưng em muốn thống kê hết các số xuất hiện max, gần max, gần (gần max) thì code vba thế nào ạ ? Như dòng số trên sẽ ra kết quả thông báo: "3 xuất hiện 4 lần; 4 xuất hiện 2 lần; 5 xuất hiện 2 lần; 7 xuất hiện 2 lần"
 
Vẫn bài này nhưng em muốn thống kê hết các số xuất hiện max, gần max, gần (gần max) thì code vba thế nào ạ ? Như dòng số trên sẽ ra kết quả thông báo: "3 xuất hiện 4 lần; 4 xuất hiện 2 lần; 5 xuất hiện 2 lần; 7 xuất hiện 2 lần"
Chạy thử cái cùi bắp dưới đây
Mã:
Sub Sort()
Dim Nguon
Dim Mang
Dim Chuoi
Dim i, j, k
Nguon = Sheet1.Range("A1:A10")
ReDim Mang(9)
For i = 1 To UBound(Nguon)
    Mang(Nguon(i, 1)) = Mang(Nguon(i, 1)) + 1
    If k < Mang(Nguon(i, 1)) Then k = Mang(Nguon(i, 1))
Next i
ReDim Chuoi(k)
For j = 0 To 9
    If Mang(j) Then
        i = k - Mang(j)
        Chuoi(i) = Chuoi(i) & " " & j & "_" & Mang(j) & "lan"
    End If
Next j
Chuoi = Replace(WorksheetFunction.Trim(Join(Chuoi)), " ", ", ")
Sheet1.Range("C1") = Chuoi
End Sub
 
Với kiến thức vòng lặp & phương thức FIND() ta có thể làm như sau & kết quả tàm tạm:
PHP:
Sub LietKe10()
Dim Arr(), WF As Object, Rng As Range, sRng As Range
Dim J As Long, W As Integer, Max_ As Integer, Min_ As Integer, Dm As Integer
Dim MyAdd As String

Set WF = Application.WorksheetFunction
Set Rng = [A9].CurrentRegion
Arr() = Rng.Value
Max_ = WF.Max(Rng):                              Min_ = WF.Min(Rng)
ReDim dArr(1 To (1 + Max_ - Min_), 1 To 2)
For J = Min_ To Max_
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Dm = Dm + 1:             Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If Dm Then
            W = W + 1:                      dArr(W, 1) = J & " Có "
            dArr(W, 2) = Str(Dm) & " Lân":                Dm = 0
        End If
    End If
Next J
[D2].Resize(W, 2).Value = dArr()
End Sub
 
Lần chỉnh sửa cuối:

Bài viết mới nhất

Back
Top Bottom