haav | Дата: Воскресенье, 09.02.2014, 12:38 | Сообщение # 1 |
Генералиссимус
Группа: Администраторы
Сообщений: 1363
Статус: Offline
| Данная реализация конечно отличается от словарей С++, но все же сходство есть.
Принцип работы со словарем: 1) Значения заносятся вместе с ключом, который должен быть не повторяющимся. Если будет попытка заполнения с повторяющимся ключом, то заполнения этого ключа со значением не произойдет.
2) Получение значения происходит по ключу
3) Так же можно получить все значения словаря, при этом они будут возвращены в отсортированном виде.
4) Если значение в словарь было отправлено с определенным типом, то и получать нужно в такой же тип. Иначе будет возвращен ноль.
5) Для словаря сделаны 3 типа: Double, Integer , String
6) Можно удалять как отдельную запись, так и очищать весь словарь
Сам код словаря:
Код ReDim Shared SortMapS() As String
ReDim Shared SortMapI() As Integer
ReDim Shared SortMapD() As Double
Namespace MapOOP
Type TChildMap
pNext As TChildMap Ptr
pPrev As TChildMap Ptr
szKey As ZString*256
sValue As ZString*256
iValue As Integer
dValue As Double
End Type
Type TMap
iCount As Integer
iCurrent As Integer
pFirst As TChildMap Ptr
pLast As TChildMap Ptr
Declare Destructor()
Declare Sub Add(szKey As String , sValue As String)
Declare Sub Add(szKey As String , sValue As Integer)
Declare Sub Add(szKey As String , sValue As Double)
Declare Sub Del (szKey As String)
Declare Sub Clear()
Declare Sub Get(szKey As String, ByRef sReturnValue As String)
Declare Sub Get(szKey As String, ByRef iReturnValue As Integer)
Declare Sub Get(szKey As String, ByRef dReturnValue As Double)
Declare Sub GetNext(ByRef sReturnValue As String)
Declare Sub GetNext(ByRef iReturnValue As Integer)
Declare Sub GetNext(ByRef dReturnValue As Double)
Declare Sub Reset()
End Type
' ---------------------Добавление в словарь------------------- #Macro MACRO_MAP_ADD( M_TYPE , M_VALUE )
Sub TMap.Add(szKey As String , Value As M_TYPE)
Dim pCheck As TChildMap Ptr = pFirst
Do While pCheck
If pCheck->szKey = szKey Then
Exit Sub
EndIf
pCheck = pCheck->pNext
Loop
Dim pTemp As TChildMap Ptr = New TChildMap
M_VALUE = Value
pTemp->szKey = szKey
If pFirst = 0 Then
pFirst = pTemp
Else
pLast->pNext = pTemp
pTemp->pPrev = pLast
EndIf
pLast = pTemp
iCount+=1
End Sub
#EndMacro
MACRO_MAP_ADD(String,pTemp->sValue)
MACRO_MAP_ADD(Integer,pTemp->iValue)
MACRO_MAP_ADD(Double,pTemp->dValue) '////////////////////////////////////////////////////////////////
' ---------------------Получение значения по заданному ключу------------------- #Macro MACRO_MAP_GET( M_TYPE , M_VALUE )
Sub TMap.Get(szKey As String, ByRef ReturnValue As M_TYPE)
Dim As M_TYPE TempClear
ReturnValue = TempClear
Dim pTemp As TChildMap Ptr
pTemp = pFirst
Do While pTemp
If pTemp->szKey = szKey Then
ReturnValue = M_VALUE
Exit Sub
EndIf
pTemp = pTemp->pNext
Loop
End Sub
#EndMacro
MACRO_MAP_GET(String,pTemp->sValue)
MACRO_MAP_GET(Integer,pTemp->iValue)
MACRO_MAP_GET(Double,pTemp->dValue) '////////////////////////////////////////////////////////////////
' ---------------------Сброс счетчика массива------------------- Sub TMap.Reset()
iCurrent = 0
End Sub '////////////////////////////////////////////////////////////////
#Macro MACRO_MAP_GETNEXT( M_TYPE , M_NAME_ARRAY , M_NAME_PROC, M_VALUE)
' ---------------------Сортировка------------------- Sub M_NAME_PROC(start As Integer,Finish As Integer)
Dim As Integer I=start,J=Finish
Dim As M_TYPE X = M_NAME_ARRAY(Int((I+J)/2)),A
While I <= J
While M_NAME_ARRAY(I) < X
I+=1
Wend
While M_NAME_ARRAY(J) > X
J-=1
Wend
If I<=J Then
A = M_NAME_ARRAY(I)
M_NAME_ARRAY(I) = M_NAME_ARRAY(J)
M_NAME_ARRAY(J) = A
I+=1
J-=1
EndIf
Wend
If J > Start Then M_NAME_PROC(start,J)
If I < Finish Then M_NAME_PROC(I,Finish)
End Sub '////////////////////////////////////////////////////////////////
' ---------------------Получение отсортированных значений по порядку------------------- Sub TMap.GetNext(ByRef ReturnValue As M_TYPE)
Dim As M_TYPE TempClear
ReturnValue = TempClear
If iCurrent = 0 Then
ReDim M_NAME_ARRAY(iCount-1) As M_TYPE
Dim pTemp As TChildMap Ptr
Dim As Integer i
pTemp = pFirst
Do While pTemp
M_NAME_ARRAY(i) = M_VALUE
pTemp = pTemp->pNext
i+=1
Loop
M_NAME_PROC(0,iCount-1)
EndIf
If iCurrent <= iCount-1 Then
ReturnValue = M_NAME_ARRAY(iCurrent)
iCurrent+=1
EndIf
End Sub
#EndMacro '////////////////////////////////////////////////////////////////
MACRO_MAP_GETNEXT(String,SortMapS,QSORTS, pTemp->sValue)
MACRO_MAP_GETNEXT(Integer,SortMapI,QSORTI, pTemp->iValue)
MACRO_MAP_GETNEXT(Double,SortMapD,QSORTD, pTemp->dValue)
' -----------------------Удаление одного ключа из словаря-------------------- Sub TMap.Del (szKey As String)
Dim pTemp As TChildMap Ptr
pTemp = pFirst
Do While pTemp
If pTemp->szKey = szKey Then
If pTemp = pFirst Then
pFirst = pFirst->pNext
Else
pTemp->pPrev->pNext = pTemp->pNext
End If
If pLast = pTemp Then
pLast = pLast->pPrev
Else
pTemp->pNext->pPrev = pTemp->pPrev
End If
Delete pTemp
iCount-=1
Exit Sub
End If
pTemp = pTemp->pNext
Loop
End Sub '////////////////////////////////////////////////////////////////
' -----------------------Удаление словаря-------------------- Destructor TMap()
this.Clear()
End Destructor '////////////////////////////////////////////////////////////////
' -----------------------Очистка словаря-------------------- Sub TMap.Clear()
Dim pTemp As TChildMap Ptr
Dim pDel As TChildMap Ptr = pFirst
If pDel Then
Do
pTemp = pDel->pNext
Delete pDel
pDel = pTemp
Loop While pTemp<>0
pFirst = 0
pLast = 0
iCount = 0
ReDim SortMapS(0) As String
ReDim SortMapI(0) As Integer
ReDim SortMapD(0) As Double
EndIf
End Sub '////////////////////////////////////////////////////////////////
End Namespace А это примеры:
Код ' Пример 1 Using MapOOP ' открываем пространство имен
Dim map As TMap Ptr = New TMap ' создаем словарь
' Загоняем 100 случайных значений с ключами от 1 до 100 For i As Integer = 1 To 100
map->Add(Str(i),i*rnd)
Next
Dim As double dRet ' переменная куда будет возвращаться результат
map->Reset ' сбрасываем словарь на начало, необходимо перед выводом всех значений
' проходим по всему словарю , map->iCount - это кол-во записей в словаре ' значения будут отсортированы For i As Integer = 1 To map->iCount
map->GetNext(dRet) ' получаем значение
? dRet ' выводим его в консоль
Next
Sleep Код ' Пример 2 Using MapOOP ' открываем пространство имен
Dim map As TMap Ptr = New TMap ' создаем словарь
' Заносим три значения в словарь map->Add("en","English Language")
map->Add("ru","Russian Language")
map->Add("ge","German Language")
Dim As string sRet ' переменная куда будет возвращаться результат
map->Get("ge",sRet) ' получаем значение с ключом "ge"
? sRet ' выводим его в консоль
map->Get("en",sRet) ' получаем значение с ключом "en"
? sRet ' выводим его в консоль
Sleep
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |
Alec | Дата: Воскресенье, 09.02.2014, 22:25 | Сообщение # 2 |
Лейтенант
Группа: Друзья
Сообщений: 73
Статус: Offline
| Интересно. Буду иметь в виду для использования словаря в своих играх. Спасибо.
WorldSim3D - 3D движок для FreeBasic, для PC. Мощная 3D графика и простота программирования. Ознакомиться.
|
|
| |
haav | Дата: Понедельник, 10.02.2014, 08:09 | Сообщение # 3 |
Генералиссимус
Группа: Администраторы
Сообщений: 1363
Статус: Offline
| Alec! На самом деле это не словарь, а связанный список , который имитирует удобство обращения к данным как у словаря. Так что, такой же скорости получения значения по ключу как у словаря, ждать не приходится. Но лично мне для большинства задач, все это дело вполне подойдет. Я не знал сам принцип устройства словаря , поэтому сделал как сумел придумать. Однако если данная реализация будет кому то полезна, я буду очень рад.
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |