purebasic.info

PureBasic forum
Текущее время: Сб июн 23, 2018 12:52 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 5 ] 
Автор Сообщение
СообщениеДобавлено: Вс май 25, 2014 6:43 pm 
Не в сети
PureBasic Coder
Аватар пользователя

Зарегистрирован: Чт ноя 10, 2011 10:50 am
Сообщений: 4049
Откуда: Ростов-на-Дону
Благодарил (а): 70 раз.
Поблагодарили: 81 раз.
Пункты репутации: 24
Пользовательская сортировка массива. К сожалению, для числового и строкового массива процедуры немного различаются, не знаю, как исправить. Пока что сыро. Потом планирую добавить сортировку списков и карт, а также оформить всё в виде модуля и полностью доработанным отправить Фреду.
Цитата:
Формат процедуры
Процедура содержит 3 параметра: 2 элемента и пользовательский параметр. Пример:
Код:
1
2
3
4
5
6
7
8
9
10
11
Procedure SortIntegers(*El1, *El2, Param)
  Protected el1 = *El1
  Protected el2 = *El2
  If el1 > el2
    ProcedureReturn 1
  ElseIf el1 < el2
    ProcedureReturn -1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure


Если первый элемент больше второго, процедура должна вернуть 1.
Если второй больше первого, процедура должна вернуть -1.
Если элементы равны, процедура должна вернуть 0
.

Для числовых не могу придумать примера - поэтому без примера
Код:
1
2
3
4
5
6
7
8
9
10
11
Procedure SortArrayU(Array ArrayName(1), *Function, Type, Param = 0)
  Protected i, j, size = ArraySize(ArrayName())
  For i = 0 To size
    For j = size To i Step -1
      Protected res = CallFunctionFast(*Function, ArrayName(i), ArrayName(j), Param)
      If (res = 1 And Type = #PB_Sort_Ascending) Or (res = -1 And Type = #PB_Sort_Descending)
        Swap ArrayName(i), ArrayName(j)
      EndIf
    Next
  Next
EndProcedure


Для строковых массивов я взял сортировку дат в формате ДД/ММ/ГГГГ
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Procedure SortDates(*El1, *El2, Param) ;Сортируем даты
  Protected Date1.s = PeekS(*El1)
  Protected Date2.s = PeekS(*El2)
  Protected d1 = ParseDate("%dd/%mm/%yyyy", Date1)
  Protected d2 = ParseDate("%dd/%mm/%yyyy", Date2)
  If d1 > d2
    ProcedureReturn 1
  ElseIf d1 < d2
    ProcedureReturn -1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
 
Procedure SortStrArrayU(Array ArrayName.s(1), *Function, Type, Param = 0)
  Protected i, j, size = ArraySize(ArrayName())
  Protected el1$, el2$
  For i = 0 To size
    For j = size To i Step -1
      el1$ = ArrayName(i)
      el2$ = ArrayName(j)
      Protected res = CallFunctionFast(*Function, @el1$, @el2$, Param)
      If (res = 1 And Type = #PB_Sort_Ascending) Or (res = -1 And Type = #PB_Sort_Descending)
        Swap ArrayName(i), ArrayName(j)
      EndIf
    Next
  Next
EndProcedure
 
Dim Dates.s(10)
For i = 1 To 10
  Dates(i) = FormatDate("%dd/%mm/%yyyy", Random(Date()-1000, 0))
Next
;==============================================================================================
SortStrArrayU(Dates(), @SortDates(), #PB_Sort_Ascending) ;Сообщаем процедуре, что сортировка ведётся по возрастанию
;==============================================================================================
For i = 1 To 10
  Debug Dates(i)
Next

Если в параметре Type указать #PB_Sort_Descending, то даты будут выведены в порядке убывания

_________________
Пурик - лучший язык программирования


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс май 25, 2014 9:34 pm 
Не в сети
лентяй ужасный
Аватар пользователя

Зарегистрирован: Вс фев 27, 2011 4:23 pm
Сообщений: 646
Благодарил (а): 4 раз.
Поблагодарили: 5 раз.
Я как-то больше на вот это намекал. То есть разбить сортировку на маленькие блоки, а не все в одной кучи. Так, что бы свободы больше было. Есть стандартный типы сортировки, типо Ascending, Descending, Random. А если они не по душе, не подходят по типу, скорости и т.д., взял да написал свою функцию (типо Рандома) и все.
Но и тут есть зависимость от типов данных, так что придется немного подумать.

P.S Не понятно, на кой ты 0 из процедуры возвращаешь, если его нигде потом не проверяешь.

И еще, если собрался что то Фреду слать, нужно что бы действительно быстро работало, а то как то не очень :/
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
Procedure  PB_Sort_Ascending(a,b)
  If a<b: ProcedureReturn 1
  Else: ProcedureReturn 0
  EndIf
EndProcedure
 
Procedure  PB_Sort_Descending(a,b)
  If a>b: ProcedureReturn 1
  Else: ProcedureReturn 0
  EndIf
EndProcedure
 
Procedure  PB_Sort_Random(a,b)
  If Random(100)<50: ProcedureReturn 1
  Else: ProcedureReturn 0
  EndIf
EndProcedure
 
Procedure SortArrayPB(Array Arr.l(1), *Func)
  Define.i i,j, flag=1
  Define.i temp, numLength = ArraySize(Arr())
  For i=1 To numLength
    flag=0
    For j = 0 To numLength-1
      If CallFunctionFast(*Func, Arr(j+1), Arr(j))
        temp=Arr(j)
        Arr(j)=Arr(j+1)
        Arr(j+1)=temp
        flag=1
      EndIf
    Next
  Next
EndProcedure
 
Procedure PrintArr(Array Arr.l(1))
aSize = ArraySize(Arr())
For k = 0 To aSize
  Debug Arr(k)
Next
Debug "----"
EndProcedure
 
Dim MyArray.l(9)
For k = 0 To 9
  MyArray(k)=k
Next
PrintArr(MyArray())
 
SortArrayPB(MyArray(), @PB_Sort_Descending()): PrintArr(MyArray())
SortArrayPB(MyArray(), @PB_Sort_Ascending()) : PrintArr(MyArray())
SortArrayPB(MyArray(), @PB_Sort_Random())    : PrintArr(MyArray())
 



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс май 25, 2014 9:58 pm 
Не в сети
PureBasic Coder
Аватар пользователя

Зарегистрирован: Чт ноя 10, 2011 10:50 am
Сообщений: 4049
Откуда: Ростов-на-Дону
Благодарил (а): 70 раз.
Поблагодарили: 81 раз.
Пункты репутации: 24
Цитата:
P.S Не понятно, на кой ты 0 из процедуры возвращаешь, если его нигде потом не проверяешь.
Я проверяю 1 и -1.
По поводу отправки Фреду - я же сказал, после доработки

_________________
Пурик - лучший язык программирования


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Пн май 26, 2014 8:51 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вс дек 09, 2012 9:02 pm
Сообщений: 771
Откуда: Дагестан
Благодарил (а): 0 раз.
Поблагодарили: 11 раз.
Пункты репутации: 0
Цитата:
По поводу отправки Фреду
Как это надо сделать? Мне тоже надо много чего отправить.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Пн май 26, 2014 8:59 am 
Не в сети
PureBasic Coder
Аватар пользователя

Зарегистрирован: Чт ноя 10, 2011 10:50 am
Сообщений: 4049
Откуда: Ростов-на-Дону
Благодарил (а): 70 раз.
Поблагодарили: 81 раз.
Пункты репутации: 24
На официальном форуме напиши

_________________
Пурик - лучший язык программирования


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 5 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB