LArray, SArray, StringPointer (Update)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8812
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

LArray, SArray, StringPointer (Update)

Beitrag von NicTheQuick »

Hier eine kleine Hilfe für alle, die dynamisch Array erstellen wollen. Ich
denke es ist vieles selbsterklärend.

LArray.pbi (inkl. Beispiel)

Code: Alles auswählen

Structure LArray
  *arr
  c.l
EndStructure

Procedure LA_Add(*LArray.LArray, Long.l, Elements.l = 1) ;Fügt einen Long-Wert ans Ende hinzu
  Protected *tmp.Long
  
  *tmp = ReAllocateMemory(*LArray\arr, (*LArray\c + Elements) * SizeOf(Long))
  If *tmp
    *LArray\arr = *tmp
    *tmp + *LArray\c * SizeOf(Long)
    *tmp\l = Long
    *LArray\c + Elements
    
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure LA_Del(*LArray.LArray, pos.l) ;Löscht einen Long-Wert
  Protected *tmp
  
  If pos >= 0 And pos < *LArray\c
    *tmp = *LArray\arr + pos * SizeOf(Long)
    MoveMemory(*tmp + SizeOf(Long), *tmp, (*LArray\c - pos - 1) * SizeOf(Long))
    *LArray\c - 1
    If *LArray\c
      *LArray\arr = ReAllocateMemory(*LArray\arr, *LArray\c * SizeOf(Long))
    Else
      FreeMemory(*LArray\arr)
      *LArray\arr = 0
    EndIf
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure LA_Set(*LArray.LArray, pos.l, Long.l) ;Setzt einen Long-Wert
  Protected *tmp.Long
  
  If pos >= 0 And pos < *LArray\c
    *tmp = *LArray\arr + pos * SizeOf(Long)
    
    *tmp\l = Long
    
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure.l LA_Get(*LArray.LArray, pos.l) ;Gibt einen Long-Wert zurück
  Protected *tmp.Long
  
  If pos >= 0 And pos < *LArray\c
    *tmp = *LArray\arr + pos * SizeOf(Long)
    
    ProcedureReturn *tmp\l
  EndIf
  
  ProcedureReturn 0
EndProcedure

Procedure LA_Move(*LArray.LArray, pos.l, newpos.l) ;Verschiebt ein Long an eine andere Position
  Protected Long.l, *tmp.Long
  
  If pos = newpos : ProcedureReturn #False : EndIf
  If pos >= 0 And newpos >= 0 And pos < *LArray\c And newpos < *LArray\c
    *tmp = *LArray\arr + pos * SizeOf(Long)
    Long = *tmp\l
    
    If pos < newpos
      MoveMemory(*tmp + SizeOf(Long), *tmp, (newpos - pos) * SizeOf(Long))
      *tmp = *LArray\arr + newpos * SizeOf(Long)
      *tmp\l = Long
    Else
      *tmp = *LArray\arr + newpos * SizeOf(Long)
      MoveMemory(*tmp, *tmp + SizeOf(Long), (pos - newpos) * SizeOf(Long))
      
      *tmp\l = Long
    EndIf
  EndIf
EndProcedure

Procedure LA_Clear(*LArray.LArray) ;Löscht alle Longs im Array
  Protected a.l
  
  If *LArray\arr : FreeMemory(*LArray\arr) : EndIf
  *LArray\arr = 0
  *LArray\c = 0
EndProcedure

Structure Arrays
  a.LArray
  b.LArray
EndStructure

Define var.Arrays

For i = 1 To 10
  LA_Add(var\a, i)
Next
For i = 1 To 4
  LA_Add(var\b, 100 + i)
Next

Debug "Array a"
For i = 0 To var\a\c - 1
  Debug LA_Get(var\a, i)
Next
Debug "Array b"
For i = 0 To var\b\c - 1
  Debug LA_Get(var\b, i)
Next
SArray.pbi (Analog zu LArray.pbi)

Code: Alles auswählen

XIncludeFile "StringPointer.pbi"

Structure SArray
  *arr
  c.l
EndStructure

Procedure SA_Add(*SArray.SArray, String.s, Elements.l = 1)
  Protected *tmp
  
  *tmp = ReAllocateMemory(*SArray\arr, (*SArray\c + Elements) * SizeOf(*tmp))
  If *tmp
    *SArray\arr = *tmp
    *tmp + *SArray\c * SizeOf(*tmp)
    SetString(*tmp, String)
    *SArray\c + Elements
    
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure SA_Del(*SArray.SArray, pos.l)
  Protected *tmp
  
  If pos >= 0 And pos < *SArray\c
    *tmp = *SArray\arr + pos * SizeOf(*tmp)
    SetString(*tmp)
    MoveMemory(*tmp + SizeOf(*tmp), *tmp, (*SArray\c - pos - 1) * SizeOf(*tmp))
    *SArray\c - 1
    If *SArray\c
      *SArray\arr = ReAllocateMemory(*SArray\arr, *SArray\c * SizeOf(*tmp))
    Else
      FreeMemory(*SArray\arr)
      *SArray\arr = 0
    EndIf
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure SA_Set(*SArray.SArray, pos.l, String.s)
  Protected *tmp
  
  If pos >= 0 And pos < *SArray\c
    *tmp = *SArray\arr + pos * SizeOf(*tmp)
    
    SetString(*tmp, String)
    
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure.s SA_Get(*SArray.SArray, pos.l)
  Protected *tmp
  
  If pos >= 0 And pos < *SArray\c
    *tmp = *SArray\arr + pos * SizeOf(*tmp)
    
    ProcedureReturn GetString(*tmp)
  EndIf
  
  ProcedureReturn ""
EndProcedure

Procedure SA_Move(*SArray.SArray, pos.l, newpos.l)
  Protected *String, *tmp.SArray
  
  If pos = newpos : ProcedureReturn #False : EndIf
  If pos >= 0 And newpos >= 0 And pos < *SArray\c And newpos < *SArray\c
    *tmp = *SArray\arr + pos * SizeOf(Long)
    *String = *tmp\arr
    
    If pos < newpos
      MoveMemory(*tmp + SizeOf(*String), *tmp, (newpos - pos) * SizeOf(*String))
      *tmp = *SArray\arr + newpos * SizeOf(*String)
      *tmp\arr = *String
    Else
      *tmp = *SArray\arr + newpos * SizeOf(*String)
      MoveMemory(*tmp, *tmp + SizeOf(*String), (pos - newpos) * SizeOf(*String))
      
      *tmp\arr = *String
    EndIf
  EndIf
EndProcedure

Procedure SA_Clear(*SArray.SArray)
  Protected a.l, *tmp = *SArray\arr
  
  For a = 1 To *SArray\c
    SetString(*tmp)
    *tmp + SizeOf(String)
  Next
  
  If *SArray\arr : FreeMemory(*SArray\arr) : EndIf
  *SArray\arr = 0
  *SArray\c = 0
EndProcedure
StringPointer.pbi (wird von SArray.pbi genutzt, inkl. Beispiel)

Code: Alles auswählen

;Info: SetString, GetString, StringLength

Procedure SetString(*pPtr.Long, String.s = "") ;Setzt den String. "" löscht den String
  Protected Size.l = Len(String)
  
  If Size = 0
    If *pPtr\l
      FreeMemory(*pPtr\l)
      *pPtr\l = 0
      ProcedureReturn #True
    Else
      ProcedureReturn #True
    EndIf
  EndIf
  
  *pPtr\l = ReAllocateMemory(*pPtr\l, Size + SizeOf(Long) + 1)
  
  If *pPtr\l
    PokeL(*pPtr\l, Size)
    PokeS(*pPtr\l + SizeOf(Long), String)
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

Procedure.s GetString(*pPtr.Long) ;Gibt den String zurück
  If *pPtr\l
    ProcedureReturn PeekS(*pPtr\l + SizeOf(Long), PeekL(*pPtr\l))
  EndIf
  
  ProcedureReturn ""
EndProcedure

Procedure.l StringLength(*pPtr.Long) ;Gibt die Stringlänge zurück
  If *pPtr\l
    ProcedureReturn PeekL(*pPtr\l)
  EndIf
  
  ProcedureReturn 0
EndProcedure

Define *String

SetString(@*String, "Hallo")
Debug StringLength(@*String)
Debug GetString(@*String)

SetString(@*String)
Debug StringLength(@*String)
Debug GetString(@*String)
Zuletzt geändert von NicTheQuick am 26.03.2008 13:52, insgesamt 1-mal geändert.
Benutzeravatar
Karl
Beiträge: 520
Registriert: 21.07.2005 13:57
Wohnort: zu Hause

Beitrag von Karl »

Der Vorteil gegenüber einer LL soll wohl vermutlich der Indexzugriff sein.

Die Einfüge-Operation hat schlimmstenfalls O(n)-Laufzeit genau wie die Move-Operation. Das Finden dauert dagegen nur O(1). Wer viel sucht, ist damit wohl gut beraten.

Für Strings halte ich Hashing grundsätzlich für geeigneter. Für die Longs ist vielleicht die einfache LL ausreichend - verschieben dann mit einem Hilfselement.

Gruß Karl
The Kopyright Liberation Front also known as the justified ancients of Mumu!
PB 5.X
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8812
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Nunja, es geht hier auch weniger um Geschwindigkeit als viel mehr um
Einfachheit und dynamische Arrays in Strukturen.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8812
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Hier noch eine erweiterte Version der StringPointer:

Code: Alles auswählen

;Info: String_Set, String_Get, String_Length, String_Copy

; String_Set(0, "test")
;    Erstellt einen neuen String mit dem Inhalt "test" und gibt das Handle zurück
; String_Set(@hnd, "bla")
;    Weist dem String mit dem Handle hnd den Inhalt "bla" zu
; String_Set(@hnd, "")  oder  String_Set(@hnd)
;    Setzt einen Leerstring bzw. löscht den String, womit das Handle 0 wird
Procedure String_Set(*pPtr.Long, String.s = "")
  Protected Size.l = Len(String)
  
  If *pPtr = 0
    If Size = 0 : ProcedureReturn 0 : EndIf
    *pPtr = AllocateMemory(Size + SizeOf(Long) + 1)
    PokeL(*pPtr, Size)
    PokeS(*pPtr + SizeOf(Long), String)
    ProcedureReturn *pPtr
  EndIf
  
  If Size = 0
    If *pPtr\l
      FreeMemory(*pPtr\l)
      *pPtr\l = 0
      ProcedureReturn #True
    Else
      ProcedureReturn #True
    EndIf
  EndIf
  
  *pPtr\l = ReAllocateMemory(*pPtr\l, Size + SizeOf(Long) + 1)
  
  If *pPtr\l
    PokeL(*pPtr\l, Size)
    PokeS(*pPtr\l + SizeOf(Long), String)
    ProcedureReturn #True
  EndIf
  
  ProcedureReturn #False
EndProcedure

; String_Get(@hnd)
;    Gibt den String über das Handle hnd als PB-String zurück
Procedure.s String_Get(*pPtr.Long)
  If *pPtr\l
    ProcedureReturn PeekS(*pPtr\l + SizeOf(Long), PeekL(*pPtr\l))
  EndIf
  
  ProcedureReturn ""
EndProcedure

; String_Length(@hnd)
;    Gibt die Länge des Strings mit dem Handle hnd zurück
Procedure.l String_Length(*pPtr.Long)
  If *pPtr\l
    ProcedureReturn PeekL(*pPtr\l)
  EndIf
  
  ProcedureReturn 0
EndProcedure

; String_Copy(@hnd)
;    Kopiert den String mit dem Handle hnd in einen neuen und gibt dessen Handle zurück
Procedure String_Copy(*pPtr.Long)
  Protected *Copy
  
  If *pPtr\l
    *Copy = AllocateMemory(PeekL(*pPtr\l) + SizeOf(Long) + 1)
    If *Copy
      CopyMemory(*pPtr\l, *Copy, PeekL(*pPtr\l) + SizeOf(Long) + 1)
      ProcedureReturn *Copy
    EndIf
  EndIf
  
  ProcedureReturn *Copy
EndProcedure

;"Hallo" in *s1 speichern
*s1 = String_Set(0, "Hallo")

;*s1 auf *s3 referenzieren
*s3 = *s1

;*s1 in *s2 speichern
*s2 = String_Copy(@*s1)

;"Tschüss" in *s1 speichern
String_Set(@*s1, "Tschüss!")

;*s1 und *s2 ausgeben
Debug String_Get(@*s1)
Debug String_Get(@*s2)

;da *s3 nur referenziert wurde ist der Inhalt der selbe wie in *s1
Debug String_Get(@*s3)
Warum das ganze?

Code: Alles auswählen

Define *PB.String = AllocateMemory(SizeOf(String))

Debug "PB-Strings:"
Debug "Pointer zum String"
Debug PeekL(*PB)

Debug "String 'Hallo' zuweisen"
*PB\s = "Hallo"

Debug "Pointer zum String und Inhalt"
Debug PeekL(*PB)
Debug *PB\s

Debug "Leerstring zum Löschen zuweisen"
*PB\s = ""

Debug "Pointer zum String besteht immer noch und Speicher ist noch allokiert"
Debug PeekL(*PB)

Debug "*PB freigeben, womit der Leerstring weiterhin besteht und Speicher frisst"
FreeMemory(*PB)

Debug ""
Define *NTQ

Debug "NTQ-Strings:"
Debug "Pointer zum String"
Debug *NTQ

Debug "String 'Hallo' zuweisen"
String_Set(@*NTQ, "Hallo")

Debug "Pointer zum String und Inhalt"
Debug *NTQ
Debug String_Get(@*NTQ)

Debug "Leerstring zum Löschen zuweisen"
String_Set(@*NTQ, "")

Debug "Pointer zum String besteht nicht mehr und Speicher für String wurde freigegeben"
Debug *NTQ
Debug String_Get(@*NTQ)
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8812
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag von NicTheQuick »

Hab nochmal ein Update, weil es so leichter zu handhaben ist.

Code: Alles auswählen

;Info: SetString, GetString, StringLength

;Versionsinfo: (Jahr-2008.Monat.Tag.Nr)
; + 0.4.2.1
;   - Unicode-fähig gemacht
;   - (!) String_Get() und String_Length() von @hnd auf hnd umgestellt
;   - Structure StringP endlich mit PeekS() nutzbar gemacht

Structure StringP
  length.l
  s.Long
EndStructure

; String_Set(0, "test")
;    Erstellt einen neuen String mit dem Inhalt "test" und gibt das Handle zurück
; String_Set(@hnd, "bla")
;    Weist dem String mit dem Handle hnd den Inhalt "bla" zu
; String_Set(@hnd, "")  oder  String_Set(@hnd)
;    Setzt einen Leerstring bzw. löscht den String, womit das Handle 0 wird
Procedure String_Set(*pPtr.Long, String.s = "")
  Protected Size.l = Len(String)
  
  If *pPtr = 0
    If Size = 0 : ProcedureReturn 0 : EndIf
    *pPtr = AllocateMemory(Size * SizeOf(Character) + SizeOf(Long) + 1)
    PokeL(*pPtr, Size)
    PokeS(*pPtr + SizeOf(Long), String)
    ProcedureReturn *pPtr
  EndIf
  
  If Size = 0
    If *pPtr\l
      FreeMemory(*pPtr\l)
      *pPtr\l = 0
    EndIf
    ProcedureReturn 0
  EndIf
  
  *pPtr\l = ReAllocateMemory(*pPtr\l, Size * SizeOf(Character) + SizeOf(Long) + 1)
  
  If *pPtr\l
    PokeL(*pPtr\l, Size)
    PokeS(*pPtr\l + SizeOf(Long), String)
    ProcedureReturn *pPtr\l
  EndIf
  
  ProcedureReturn 0
EndProcedure

; String_Get(@hnd)
;    Gibt den String über das Handle hnd als PB-String zurück
Procedure.s String_Get(*hnd)
  If *hnd
    ProcedureReturn PeekS(*hnd + SizeOf(Long), PeekL(*hnd))
  EndIf
  
  ProcedureReturn ""
EndProcedure

; String_Length(@hnd)
;    Gibt die Länge des Strings mit dem Handle hnd zurück
Procedure.l String_Length(*hnd)
  If *hnd
    ProcedureReturn PeekL(*hnd)
  EndIf
  
  ProcedureReturn 0
EndProcedure

; String_Copy(@hnd)
;    Kopiert den String mit dem Handle hnd in einen neuen und gibt dessen Handle zurück
Procedure String_Copy(*pPtr.Long)
  Protected *Copy = 0, size.l
  
  If *pPtr\l
    size = PeekL(*pPtr\l) * SizeOf(Character) + SizeOf(Long) + 1
    *Copy = AllocateMemory(size)
    If *Copy
      CopyMemory(*pPtr\l, *Copy, size)
    EndIf
  EndIf
  
  ProcedureReturn *Copy
EndProcedure

Define *s.StringP

*s = String_Set(0, "Hallo du da!")

Debug PeekS(*s\s)
Debug *s\length

String_Set(@*s, "Juhu!")

Debug PeekS(*s\s)
Debug *s\length
Jetzt lässt sich einfacher mittels 'PeekS()' auf den String zugreifen. Und
um die Länge zu erhalten, kann man direkt die Structure nutzen.
Achso, Unicode geht jetzt auch endlich!
Antworten