Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Найти самый частый элемент массива Добавлено: 19.08.07 13:46  

Автор вопроса:  ZagZag | ICQ: 295002202 
Дано:
Массив с числами (Long)
Изначальные значения никак не отсортированы
Можно менять элементы местами.

Нужно:
Получить значение элемента, который встречается чаще всего в данном массиве. Если таких элементов несколько, то получить значение одного любого (последнего) из них.

Важно быстродействие. Я бы не задавал вопрос, а решил его при помощи сортировки, но сортировать массив накладно. Хотя, если нет других вариантов...


Ответить

  Ответы Всего ответов: 9  

Номер ответа: 1
Автор ответа:
 Mr.Smile



ICQ: 427682013 

Вопросов: 14
Ответов: 464
 Профиль | | #1 Добавлено: 19.08.07 20:09
Конечно можно вести учёт каждого значения в массиве, а в конце выбрать самый часто-встречающийся элемент в списке, но для этого потребуется большее количество времени (да и пямяти).
Если тебе надо отсортировать массив, то перебрось всё его содержимое в ListBox (с заранее установленным Sorted=True), а потом обратно.
Только я так и не понял, каким образом тебе это поможет
Получить значение элемента, который встречается чаще всего в данном массиве
. Объясни, если не трудно.

Ответить

Номер ответа: 2
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #2
Добавлено: 19.08.07 20:59
Сомневаюсь, что есть решение существенно быстрее NlogN, поэтому сортируй, а потом за один проход находи самый частый элемент.

Ответить

Номер ответа: 3
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
 Профиль | | #3 Добавлено: 19.08.07 21:21
Arcady, ну например из массива:

1,1,2,2,6,5,3,1,2,2,2,1,1,1,1,7,5,2,3,5,7

Мне нужно получить результат = 1, т.к. таких элементов больше всего.

Ответить

Номер ответа: 4
Автор ответа:
 shuffle



Администратор

ICQ: 201502381 

Вопросов: 15
Ответов: 737
 Профиль | | #4 Добавлено: 19.08.07 23:00
Если тебе надо отсортировать массив, то перебрось всё его содержимое в ListBox (с заранее установленным Sorted=True), а потом обратно
Эффективная сортировка :)

Ответить

Номер ответа: 5
Автор ответа:
 BUMM ®



Вопросов: 8
Ответов: 482
 Профиль | | #5 Добавлено: 20.08.07 03:27
пузырьком его, пузырьком :))))

Ответить

Номер ответа: 6
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
 Профиль | | #6 Добавлено: 20.08.07 08:42
Ща кое-что скажу, что возможно облегчит решение:
Размер массива = N^2, где N от 2 примерно до 100.
Первоначальная задача - обработка изображения. Фильтр "мозайка".
В массиве хранятся цвета пикселей в квадрате мозайки (NxN).
Можно конечно считать средний цвет (среднее арифметическое цветов всех всех пикселей) или просто брать первый цвет массива. Но качество результата меня не устраивает.

Ответить

Номер ответа: 7
Автор ответа:
 Neco



ICQ: 247906854 

Вопросов: 133
Ответов: 882
 Web-сайт: neco.pisem.net
 Профиль | | #7
Добавлено: 20.08.07 11:05
у меня вот как раз была такая задачка, но она мимоходом прошла - по поводу быстродействия я не парился.
В файле есть куча записей с разной датой, надо было посчитать, какой день встречается чаще всего.
Решил так: два массива - один типа Дата, другой Целое - счётчик. Датовый массив в твоём случае надо заменить тем типом, который у тебя. Массивы можно сделать сразу размером 1000 и потом просто проверять, но я так не делал - у меня в файле две, максимум три даты должно было встречаться, поэтому я на лету размер менял.
ну так вот идёшь по основному массиву и ищешь его значения в своём маленьком массиве, если находишь, то увеличиваешь в счётчиковом массиве соот-щий элемент на 1.
В конце смотришь где больше всего в массиве-счётчике и берёшь соот-щий элемент из массива-значений.
Вот кусок моего кода, определяющий дату файла по большинству записей в нём:
    Private Class FullAnalizer
        Dim a_date() As DateTime
        Dim a_count() As Integer
        Dim is_over As Boolean
        Dim rez_date As DateTime

        Public Function GetDate(ByVal filename As String) As DateTime
            ReDim a_date(-1)
            ReDim a_count(-1)
            is_over = False
            Dim foo As New clsUniverseParser
            AddHandler foo.GotSubrevPacket, AddressOf SubrevPacket
            AddHandler foo.GotRevshPacket, AddressOf RevshPacket
            Try
                foo.ParseUnknown(filename)
            Catch ex As clsSubrev.SubrevParserException
                If is_over Then
                    Return rez_date
                Else
                    Throw ex
                End If
            Catch ex As clsRevsh.RevshParserException
                If is_over Then
                    Return rez_date
                Else
                    Throw ex
                End If
            Catch ex As Exception
                Throw ex
            End Try
            If is_over Then
                Return rez_date
            Else
                Throw New Exception("Полный анализ завершился, но дата не определена!";)
            End If
        End Function
        Private Sub SubrevPacket(ByVal sender As Object, ByVal in_array() As clsSubrev.typeSubrev, ByVal Count As Integer)
            If (Not is_over) Then
                Dim f As Integer
                Dim i As Integer
                For i = 0 To Count - 1
                    f = Array.IndexOf(a_date, in_array(i).dt_charge.Date)
                    If f = -1 Then
                        Dim max As Integer = a_date.Length
                        ReDim Preserve a_date(max)
                        ReDim Preserve a_count(max)
                        a_date(max) = in_array(i).dt_charge.Date
                        a_count(max) = 1
                    Else
                        a_count(f) += 1
                    End If
                Next
                CalculateDate()
                If is_over Then
                    CType(sender, clsUniverseParser).StopParsing()
                End If
            End If
        End Sub
        Private Sub CalculateDate()
            Dim rez_indx As Integer = -1
            Dim low, hi, i As Integer
            For i = 0 To a_count.Length - 1
                If a_count(i) < a_count(low) Then
                    low = i
                End If
                If a_count(i) > a_count(hi) Then
                    hi = i
                End If
            Next
            If a_count(hi) > 1000 Then
                If hi <> low Then
                    If a_count(hi) / a_count(low) > 10 Then
                        rez_indx = hi
                    End If
                Else
                    rez_indx = hi
                End If
            End If
            If rez_indx > -1 Then
                is_over = True
                rez_date = a_date(hi)
            End If
        End Sub

        Private Sub RevshPacket(ByVal sender As Object, ByVal in_array() As clsRevsh.typeRevsh, ByVal Count As Integer)
            If (Not is_over) Then
                Dim f As Integer
                Dim i As Integer
                For i = 0 To Count - 1
                    f = Array.IndexOf(a_date, in_array(i).dt_ce.Date)
                    If f = -1 Then
                        Dim max As Integer = a_date.Length
                        ReDim Preserve a_date(max)
                        ReDim Preserve a_count(max)
                        a_date(max) = in_array(i).dt_ce.Date
                        a_count(max) = 1
                    Else
                        a_count(f) += 1
                    End If
                Next
                CalculateDate()
                If is_over Then
                    CType(sender, clsUniverseParser).StopParsing()
                End If
            End If
        End Sub
    End Class

Анализируется, кстати, лишь начало файла - до тех пор пока максимум не превысит минимум в десять раз. Для моей задачи это подходило - смотри сам.

Ответить

Номер ответа: 8
Автор ответа:
 EUGY



Вопросов: 0
Ответов: 454
 Профиль | | #8 Добавлено: 20.08.07 17:56
выкинуть в эксель и пройтись функцией "МОДА" :)

Ответить

Номер ответа: 9
Автор ответа:
 Павел



Администратор

ICQ: 326066673 

Вопросов: 368
Ответов: 5968
 Web-сайт: www.vbnet.ru
 Профиль | | #9
Добавлено: 21.08.07 07:02
Открыть фотошоп.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам