Giúp thuật toán tìm số xuất hiện nhiều nhất trong 1 dãy.

[VetMini]

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)

 

[huuthang_bd]

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.

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

 

[dtkienbs]

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"

 

[CHAOQUAY]

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

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

 

[SA_DQ]

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:

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