Die nächstkleinste freie Zahl in einer Liste finden

[Bisonte]

So... Nun hab ich mal das, was ich verstanden habe zusammengewürfelt und es kam folgendes dabei raus :

Code: Alles auswählen

DeclareModule mObjectID
  
  Declare IsID(Type.s, ID)
  Declare NewID(Type.s, *Memory, ID = #PB_Any)
  Declare FreeID(Type.s, ID)
  
EndDeclareModule
Module mObjectID
  
  EnableExplicit
  
  Structure struct_oID
    Map ID.i()
  EndStructure
  
  Global NewMap object.struct_oID()
  
  Procedure _NewDynamic(Type.s)
    
    ; DrShrek : Ermittelt einen Key anhand der vergangenen Millisekunden
    
    Protected Result, Key.s
    
    Repeat
      Key.s = Str(ElapsedMilliseconds() + 10000) ; Sichergehen, dass die vergangene Zeit auch über 10000 liegt)
      Result = FindMapElement(object(Type)\ID(), Key)
    Until Not (Result)
    
    ProcedureReturn Val(Key)
    
  EndProcedure
  Procedure IsID(Type.s, ID)
    ; Prüft, ob eine ID schon vorhanden ist
    If FindMapElement(object(Type)\ID(), Str(ID))
      ProcedureReturn #True
    EndIf
    ProcedureReturn #False
  EndProcedure
  Procedure NewID(Type.s, *Memory, ID = #PB_Any)
    
    Protected Result = -1, Key.s = ""
    
    If *Memory
      If ID = #PB_Any
        Result = _NewDynamic(Type) ; Eine ElapsedMilliseconds() ID
        object(Type)\ID(Str(Result)) = *Memory ; Den übergebenen Speicher anhängen
      ElseIf ID >-1 And ID<10001 ; Wenn eine Gültige Statische ID
        ; Hier noch Check wegen evt FreeMemory usw.
        object(Type)\ID(Str(ID)) = *Memory ; Den übergebenen Speicher anhängen
        Result = ID  
      EndIf
    EndIf
    
    ProcedureReturn Result
    
  EndProcedure
  Procedure FreeID(Type.s, ID)
    If FindMapElement(object(Type)\ID(), Str(ID))
      ; Hier noch Check wegen evt FreeMemory usw.
      DeleteMapElement(object(Type)\ID(), Str(ID))
      ProcedureReturn #True  
    EndIf
    ProcedureReturn #False
  EndProcedure
  
EndModule

Debug mObjectID::NewID("ftp", 1, #PB_Any)
Debug mObjectID::NewID("ftp", 1, #PB_Any)
a = mObjectID::NewID("ftp", 1, #PB_Any)
Debug a
Debug mObjectID::NewID("ftp", 1, #PB_Any)
Debug mObjectID::NewID("ftp", 1, 12)
Debug mObjectID::NewID("ftp", 1, 11)
Debug mObjectID::NewID("ftp", 1, 10)
Debug mObjectID::FreeID("ftp", 12)
Debug "..."
Debug mObjectID::IsID("ftp", a)
Debug mObjectID::FreeID("ftp", a)
Debug mObjectID::IsID("ftp", a)
Debug mObjectID::IsID("ftp", 11)

Die Idee mit den ElapsedMilliseconds() ist gut
Nichts für ungut Nic, aber durch dein komplettes Beispiel steig ich noch nicht durch.

Ich bedanke mich für die Mühen, die ich gemacht habe ^^

[DrShrek]

Die Idee mit den ElapsedMilliseconds() ist gut

Danke

Hier nun noch eine etwas performantere Procedure: _NewDynamic(Type.s):

Code: Alles auswählen

  Procedure _NewDynamic(Type.s)
    
    ; DrShrek : Ermittelt einen Key anhand der vergangenen Millisekunden
    
    Protected Result, Key
       Key = ElapsedMilliseconds() + 10000 ; Sichergehen, dass die vergangene Zeit auch über 10000 liegt)
       Repeat
         key+1
         Result = FindMapElement(object(Type)\ID(), Str(Key))
       Until Not(result)
    ProcedureReturn Key
   
  EndProcedure

[matbal]

Aber wirklich nötig ist ElapsedMilliseconds() nicht. Die dynamische ID soll ja nur größer als 10000 und noch unbenutzt sein. Dafür würde auch ein Zähler genügen, der die dynamische IDs bei 10001 anfängt hochzuzählen. Oder übersehe ich etwas?

[DrShrek]

Aber wirklich nötig ist ElapsedMilliseconds() nicht. Die dynamische ID soll ja nur größer als 10000 und noch unbenutzt sein. Dafür würde auch ein Zähler genügen, der die dynamische IDs bei 10001 anfängt hochzuzählen. Oder übersehe ich etwas?

Da hast Du vollkommen recht. Notwendig ist sie nicht.
Es könnte auch ein Zähler mitlaufen der einfach die ID erhöht (Der Overflow check fehlt!).

Code: Alles auswählen

  Procedure _NewDynamic()
    Static _ID = 10000
    _ID+1
    ProcedureReturn _ID
    
  EndProcedure

[NicTheQuick]

Da man ja zu einer ID typischerweise noch irgendwelche Informationen speichern will, habe ich bei mir die Möglichkeit dazu gepackt, dass man zu jeder ID ein Handle speichern kann und sie anhand der ID auch wieder abrufen kann. Das geht bei dynamischen IDs logischerweise sehr einfach, weil diese selbst schon eine Speicheradresse sind. Bei den statischen benutze ich eine Hashmap, aber da die statischen IDs auf 10000 begrenzt sind, könnte man hier auch der Einfachheit halber ein Array nehmen. Das würde dann ja auch höchstens 80 kB Speicher verbrauchen, aber dafür konstante Zeit brauchen um das Handle abzufragen.

Hier mal ein Beispiel mit meinem IDAny-Modul:

Code: Alles auswählen

DeclareModule IDAny
	Global NewMap *staticID()
	Global NewList *dynamicID()
	Declare.i newID(id.i = #PB_Any, *handle = -1)
	Declare.i freeID(id.i)
	Declare.i getHandle(id.i)
EndDeclareModule

Module IDAny
	Procedure.i newID(id.i = #PB_Any , *handle = -1)
		If (id = #PB_Any)
			If AddElement(*dynamicID())
				*dynamicID() = *handle
				ProcedureReturn @*dynamicID()
			Else
				ProcedureReturn #False
			EndIf
		ElseIf (id > 10000)
			Debug "Bitte keine statischen IDs über 10000 nutzen!"
			ProcedureReturn #False
		Else
			If (FindMapElement(*staticID(), Str(id)))
				*staticID() = *handle
			ElseIf (AddMapElement(*staticID(), Str(id), #PB_Map_NoElementCheck))
				*staticID() = *handle
			Else
				ProcedureReturn #False
			EndIf
			ProcedureReturn *handle
		EndIf
	EndProcedure
	
	Procedure.i freeID(id.i)
		If (id > 10000)
			;Geht davon aus, dass die id tatsächlich gültig ist.
			ChangeCurrentElement(*dynamicID(), id)
			DeleteElement(*dynamicID())
		ElseIf (id >= 0)
			DeleteMapElement(*staticID(), Str(id))
		EndIf
	EndProcedure
	
	Procedure getHandle(id.i)
		If (id > 10000)
			ProcedureReturn PeekI(id)
		ElseIf (id >= 0)
			ProcedureReturn *staticID(Str(id))
		EndIf
	EndProcedure
EndModule

Structure FTP
	server.s
	port.i
EndStructure

Procedure NewFTP(id.i, server.s, port.i = 21)
	Protected *ftp.FTP = AllocateStructure(FTP)
	id = IDAny::newID(id, *ftp)
	If (Not id)
		ProcedureReturn #False
	EndIf
	
	With *ftp
		\server = server
		\port = port
	EndWith
	
	ProcedureReturn id	
EndProcedure

Procedure.s GetFTPServer(id.i)
	Protected *ftp.FTP = IDAny::getHandle(id)
	If (Not *ftp)
		ProcedureReturn ""
	EndIf
	
	ProcedureReturn *ftp\server
EndProcedure

Procedure.i GetFTPPort(id.i)
	Protected *ftp.FTP = IDAny::getHandle(id)
	If (Not *ftp)
		ProcedureReturn 0
	EndIf
	
	ProcedureReturn *ftp\port
EndProcedure

NewFTP(10, "ftp.server.de")
dynID.i = NewFTP(#PB_Any, "ftp.ntq.de", 80)

Debug GetFTPServer(10)
Debug GetFTPPort(10)

Debug GetFTPServer(dynID)
Debug GetFTPPort(dynID)

[Bisonte]

Da man ja zu einer ID typischerweise noch irgendwelche Informationen speichern will...

hast Du das

Code: Alles auswählen

Declare NewID(Type.s, *Memory, ID = #PB_Any)

bei mir übersehen ?

Das mit der Speicherübergabe hatte ich schon in deinem ersten Beispiel gesehen und es auch übernommen...

[edel]

Warum benutzt du denn nicht die Objectlib?

[Bisonte]

Warum benutzt du denn nicht die Objectlib?

Aufklärung ? Welche ? Wo finde ich die ? Und wie nutzt man die ?

[edel]

Im SDK Ordner gibt es ein Beispiel, Ticker oder so.

[Regenduft]

Einfach der Diversität zu liebe mal noch meine Lösung, wenn ich eine Funktionsgruppe schreibe, die das PureBasic-Verhalten klont:

Ich erstelle eine Liste mit Zeigern zu den Objekten. Der "ListIndex" entspricht der Objektnummer. Objektnummern größer 10000 werden nicht in die Liste aufgenommen, sondern als direkte Adresse behandelt (à la #PB_Any).

Wenn beim Erstellen die Ojektnummer größergleich der Listengröße ist, aber kleinergleich 10000 ist, dann wird die Liste vergrößert, bis sie größer als die Objektnummer ist. "Größergleich" bzw. "größer" anstatt "größer" bzw. "gleich" weil die erste Objektnummer Null ist.

Wenn beim Erstellen ein Objekt bereits existiert, dann wird das alte vorher freigegeben.

Wenn ein Objekt manuell freigegeben wird und im indizierten Bereich liegt (also kleinergleich 10000) dann wird das Element an der entsprechenden Stelle im Index auf Null gesetzt. Anschließend wird solange das jeweils letzte Element im Index gelöscht, wie das jeweils letzte Element Null ist, um die Listengröße zu minimieren. Nicht vergebene Indizes irgendwo in der Mitte werden bei der Minimierung ignoriert (genau wie PureBasic es macht).

Das Verhalten entspricht (nach außen hin) 1 zu 1 dem von PureBasic bei seinen "#PB_Any-fähigen" Funktionen.

Hoffentlich habe ich mich nicht vertippt, da der Code aus keinem Projekt stammt, sondern schnell nach Schema F zusammengeschustert wurde.

PS: Bevor jemand schreit, zugegeben ist die Lösung nicht sehr viel anders als bereits gepostete...

Code: Alles auswählen

EnableExplicit


NewList *FooObjekte()

Structure FooStruktur
  was.c
  auch.b
  immer.a
EndStructure


Procedure FreeFoo( FooNummer )
  
  Shared *FooObjekte()
  Define *This.FooStruktur
  
  If FooNummer > 10000
    *This = FooNummer
    
  ElseIf FooNummer >= 0 And FooNummer < ListSize( *FooObjekte() )
    
    SelectElement( *FooObjekte() , FooNummer )
    *This = *FooObjekte()
    *FooObjekte() = #Null
    
  EndIf
  
  
  ; ===========================
  ;
  ; Hier bei Bedarf der weitere
  ; Code zur Objektlöschung
  ;
  ; ===========================
  FreeStructure( *This )
  
  
  ; Bei indiziertem Objekt Liste minimieren
  If FooNummer <= 10000
    LastElement( *FooObjekte() )
    While ListIndex( *FooObjekte() ) <> -1 And *FooObjekte() = #Null
      DeleteElement( *FooObjekte() )
    Wend
  EndIf
  
EndProcedure


Procedure.i CreateFoo( FooNummer , ParameterBla , ParameterBlie , ParameterBlubb )
  
  Shared *FooObjekte()
  Define *NewFoo.FooStruktur = AllocateStructure( FooStruktur )
  
  ; Wenn Speicherreservieung fehlschlug oder FooNummer ungültig hier abbrechen.
  If *NewFoo = #False Or FooNummer > 10000 Or ( FooNummer < 0 And FooNummer <> #PB_Any )
    If *NewFoo
      FreeStructure( *NewFoo )
    EndIf
    ProcedureReturn #False
  EndIf
  
  
  ; ===========================
  ;
  ; Hier der Objekterstellscode
  ; und im Fehlerfall:
  FreeFoo( *NewFoo )
  *NewFoo = #False
  ;
  ; ===========================
  
  
  ; #PB_Any? -> direkt Onjektadresse rückgeben
  If FooNummer = #PB_Any
    ProcedureReturn *NewFoo
    
    
  ; Foo-Objektliste zu klein? -> vergrößern!
  ElseIf FooNummer >= ListSize( *FooObjekte() )
    LastElement( *FooObjekte() )
    Repeat
      If AddElement( *FooObjekte() ) = #False
        While ListIndex( *FooObjekte() ) <> -1 And *FooObjekte() = #Null
          DeleteElement( *FooObjekte() )
        Wend
      EndIf
    Until ListSize( *FooObjekte() ) > FooNummer
    
    
  ; Ojektnummer schon vergeben? -> altes Objekt löschen!
  Else
    SelectElement( *FooObjekte() , FooNummer )
    If *FooObjekte()
      FreeFoo( *FooObjekte() ) ; per Adresse, damit die Indizierung erhalten bleibt!
    EndIf
    
  EndIf
  
  *FooObjekte() = *NewFoo
  
  ProcedureReturn Bool( *NewFoo )
  
EndProcedure


Procedure.i ManipulateFoo( FooNummer , ParameterBla , ParameterBlie , ParameterBlubb )
  
  Shared *FooObjekte()
  Define *This.FooStruktur
  
  
  If FooNummer > 10000
    *This = FooNummer
    
  ElseIf FooNummer >= 0 And FooNummer < ListSize( *FooObjekte() )
    SelectElement( *FooObjekte() , FooNummer )
    *This = *FooObjekte()
    
  Else
    ProcedureReturn #False ; oder was halt beim Fehlschlagen rückgegeben werden soll.
    
  EndIf
  
  
  ; ================================
  ;
  ; Hier der Objektmanipulationscode
  ;
  ; ================================
  
  
EndProcedure