Hei!
Olen seuraavanlaisen ongelman äärellä.
Leikitään, että ohjelma alkaa näin:
Dim ongelma() as Custom '- Private Sub Form_Load() ReDim ongelma(2) ongelma(0).data = 1 'merkintä 1 ongelma(1).data = 1 'merkintä 2 ongelma(2).data = 1 'merkintä 3 'vapaat paikat täynnä.. joten nyt haluaisin kernaasti lisää ongelmia! ReDim ongelma(5) '... End Sub"
ReDim on ollut armelias, ja pyyhkinyt pois kolme äsken luomaani merkintää. Näin ei kuitenkaan saisi tapahtua, kun muuttujan "paikkoja lisätään". Onko mahdollista muuttaa ko. ongelman kokoa, ilman että sinne aiemmin tallennetut arvot pyyhkiytyy pois?
Avainsana Preserve auttaa asiaan:
ReDim Preserve ongelma(5)
On se helppoa kun osaa.. kiitos! :)
Kannattaa muistaa, että jos ReDim Preserviä tekee jatkuvasti, niin lähes joka kerran kaikki vanhatkin tiedot kopioidaan uuteen paikkaan muistissa. Esimerkiksi jatkuva yhden elementin lisääminen aiheuttaa runsaasti tarpeetonta muistin ja prosessorin läträämistä.
Hyvä keino ulos tämmöisestä ongelmasta on käyttää apumuuttujaa, joka muistaa monesko taulukon elementti on seuraava käyttökelpoinen. Mikäli tämän apumuuttujan arvo menee ylitse UBoundin, niin sitten taulukon koon voi esimerkiksi kaksinkertaistaa. Näin vältetään jatkuva ReDim Preserve.
Kiitos vinkistä, Merri!
Päätin käyttää myös mahdolliset vapautuneet ongelmat uudelleen, joka loi helpon ratkaisun myös muistiläträykseen..
Type Custom State as single Data as single End type
Se onnistuu helposti ujuttamalla jokaisen ongelman sisään tilatieto 'State', ja samalla kun paikka täytetään, 'State' muutetaan arvoon "1".
Ja kun kaikki ongelmat käydään läpi, selviää onko vapaana olevia paikkoja. Jos ei ole, onkin syytä tuplata muuttuja... :)
Totuusarvolle oikea ja järkevä tyyppi on Boolean eikä suinkaan Single.
Jos taulukon järjestyksellä ei ole merkitystä, yksinkertaisempi (ja muistia säästävä) ratkaisu on poiston yhteydessä siirtää vain viimeinen vapautuneeseen kohtaan:
1 2 3 4 5 6 7 8 poistetaan 4: 1 2 3 8 5 6 7
Tällöin kirjanpitoon riittää tuo aiemmin mainittu laskuri ja lisääminenkin onnistuu helposti ilman turhia silmukoita.
Moikka Freeze!
jutskan voi hoitaa myös esim. siten, että kasvattaa taulukkoa ainoastaan silloin, kun sinne pukataan dataa ja poistaa mahdollisen vanhan kaman muistista swappaamalla käyttäen aputaulukkoa...
'Module1
Public Type OlioType
data As Integer
End Type
Public Olio() As OlioType'Form1
Private Sub Command1_Click()
Dim index As Integer
On Error Resume Next
index = UBound(Olio)
If Err <> 0 Then
Err.Clear
ReDim Olio(0)
On Error GoTo 0
Else
ReDim ApuOlio(UBound(Olio) + 1) As OlioType
ReDim Preserve Olio(UBound(Olio) + 1)
ApuOlio = Olio: Erase Olio
Olio = ApuOlio: Erase ApuOlio
End If
'Testi:
Static i As Integer, j As Integer
i = i + 1
Olio(UBound(Olio)).data = i
For j = LBound(Olio) To UBound(Olio)
MsgBox Olio(j).data
Next j
End SubTuo on turhaa, koska jo Preserve hoitaa homman kotiin. Swappaaminen tuolla tavoin ei tee muuta kuin kopioi ja poistaa samaa tietoa monta kertaa täysin turhaan:
' varaa ApuOliolle tilaa, varattu muistialue nollataan ReDim ApuOlio(UBound(Olio) + 1) As OlioType ' varaa Oliolle tilaa, varattu muistialue nollataan, kopioi vanha tieto uuteen muistialueeseen, vapauta vanha muistialue ReDim Preserve Olio(UBound(Olio) + 1) ' vapauta ApuOlion juuri varattu muistialue, varaa uusi muistialue ja kopioi Olion tiedot sinne, vapauta Olion muistialue ApuOlio = Olio: Erase Olio ' varaa Oliolle jälleen uusi muistialue, kopioi ApuOlion tiedot sinne, vapauta ApuOlion muistialue Olio = ApuOlio: Erase ApuOlio
Eli koodi, joka tekee paljon, mutta ei edistä asioita millään lailla.
Tässä sama idea siistittynä versiona:
Option Explicit
Private Type OlioType
data As Long
End Type
Private Olio() As OlioType
Private Sub Command1_Click()
Dim i As Long, initialized As Boolean, newindex As Long
' tarkista onko Olio määritelty, plus korjaa IDE:ssä oleva Not-bugi kutsumalla hInstancea (tämä jostain syystä korjaa bugin)
' (btw: Not Not Olio palauttaa 32-bit pointer-arvon taulukkomuuttujan safe array -rakennetietoihin, jos 0 niin taulukkoa ei ole määritelty ja mm. UBound heittäisi herjaa)
initialized = Not Not Olio
Debug.Assert App.hInstance
' newindex = 0 jos Olio ei määritelty tai > 0 jos määritelty
If initialized Then newindex = UBound(Olio) + 1
' varaa uusi paikka (tiedon sijainti muistissa saattaa vaihtua)
ReDim Preserve Olio(newindex)
' laita järjestysluku
Olio(newindex).data = newindex + 1
' heivaa tiedot ulos
Debug.Print "Olion sisältö:"
For i = 0 To UBound(Olio)
Debug.Print "Olio(" & i & ") = ", Olio(i).data
Next i
End SubTämä yllä oleva esimerkki siis lisää yhden elementin kerrallaan taulukon loppuun, mutta mitä suuremmaksi taulukko tulee, sitä raskaammaksi sen koon muuttaminen tulee.
Tässä vielä lisäyksenä neljännessä viestissä mainitsemani apumuuttujan käyttö:
Option Explicit
Private Type OlioType
data As Long
End Type
Private Olio() As OlioType
Private OlioMaara As Long
Private Sub Command1_Click()
Dim i As Long, initialized As Boolean
initialized = Not Not Olio
Debug.Assert App.hInstance
' tässä esimerkissä Preserve kutsutaan joka 16. elementin lisäämisen jälkeen
' vaihtoehtoisesti kaksinkertaistus: ReDim Preserve Olio(UBound(Olio) * 2 + 1)
If initialized Then
OlioMaara = OlioMaara + 1
If OlioMaara > UBound(Olio) Then ReDim Preserve Olio(UBound(Olio) + 16)
Else
ReDim Olio(15)
End If
Olio(OlioMaara).data = OlioMaara + 1
Debug.Print "Olion sisältö:"
For i = 0 To UBound(Olio)
Debug.Print "Olio(" & i & ") = ", Olio(i).data
Next i
End SubTässä on edelleen sama ongelma taulukon koon kanssa, mutta sitä sentään muutetaan vain joka 16:lla kutsulla.
NO MORJENS!
Merri kirjoitti:
(Merrin koko ensimmäinen viesti)
Merri kirjoitti:
(Merrin koko toinen viesti)
-Nea-
(Mod. huom: vähän järkeä nyt peliin noiden lainausten kanssa!)
Koodisi ei poista "vanhaa kamaa muistista", toisin kuin väität.
Moikka taas!
Merri@
Testaa: Kaiva jostain romulasta vanha 286, rakentele QBasic:llä (DRAW) graafinen viisarikello & kokeile loppuuko muisti vaiko eikö ilman edellä esittämääni swappaus systeemiä...
En minä mitään ole muistin loppumisesta mitään sanonut. Ehdottamasi swappaus-systeemi ei vaan tee yhtään mitään hyödyllistä.
http://merri.net/vb6/Taulukon_kasvatus.zip
Tämä linkitetty tiedosto sisältää projektin, jolla voit katsoa miten hidasta on täyttää 10000 elementtiä byte-taulukkoon ehdottamallasi menetelmällä suhteessa sittemmin esittelemääni menetelmään. Lopputulos on täsmälleen sama. Vauhti on aikalailla eri.
Liitetyssä paketissa on myös exe, sen ajaminen on omalla vastuulla.
Hei, Freeze.
Saanko udella miksi et tee kerralla riittävän suurta taulukkoa, jotta vältytään lisäämistarpeelta? Loppuuko muisti :-)
btw: jos haluat säästää muistia määrittele 'state':n tyypiksi byte (ei single tai boolean - boolean vie kokemukseni mukaan 16 bittiä!!!)
neau33 kirjoitti:
Testaa: Kaiva jostain romulasta vanha 286, rakentele QBasic:llä (DRAW) graafinen viisarikello & kokeile loppuuko muisti vaiko eikö ilman edellä esittämääni swappaus systeemiä...
Miten viisarikellon tekeminen liittyy taulukon kasvattamiseen?
MOI!
viisarikellon teko ei välttämättä liity mitenkään taulukon kasvattamiseen mutta Microsoft ei ole luonut ainuttakaan Windows-käyttöjärjestelmän versiota, joka ei hyödyntäisi swappaamista (kykenisi toimimaan ilman swappaamista)...eli onko ao. lafka päätynyt viritelmissään jatkuvasti täysin hyödyttömiin rakennelmiin..?
Jos puhut käyttöjärjestelmän harjoittamasta "swappaamisesta", niin sillä tarkoitetaan tiedon siirtämistä tietyntyyppisestä muistista toisentyyppiseen muistiin, jotta sitä toista muistia olisi näennäisesti enemmän käytettävissä. Saman muistin sisällä swappaamisesta (kuten esimerkissäsi) ei saavuteta vastaavaa hyötyä.
Olet sekoittanut sivutuksen (paging, "swap space") ja muuttujien swappauksen.
http://en.wikipedia.org/wiki/Swap_space
http://en.wikipedia.org/wiki/Swap_
Molemmista kyllä saatetaan englanniksi puhua termillä swap, mutta eri asioita ne ovat.
Ehei Merri!
Tarkoitin suoraa talukkojen osoittimien swappaamista...
Tämä on taulukoiden suora osoittimien swappaus:
Option Explicit
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Arr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Sub Command1_Click()
Dim X() As Byte, Y() As Byte
Dim Xptr As Long, Yptr As Long
ReDim X(0)
ReDim Y(0)
X(0) = 1
Y(0) = 2
Xptr = Not Not X
Yptr = Not Not Y
Debug.Assert App.hInstance
PutMem4 ArrPtr(X), Yptr
PutMem4 ArrPtr(Y), Xptr
Debug.Print "X: ", X(0)
Debug.Print "Y: ", Y(0)
End SubVähän vaikeaa VB6:ssa verrattuna vaikka C:hen, mutta onnistuu noin.
BTW!
käy se swappaaminen näinkin...eli muistityypistä toiseen ilman jatkuvan Redim Preserve käyttöä
Private Type OlioType
value As Long
state As Boolean
End Type
Private Olio() As OlioType
Private polku As String
Private Sub Command1_Click()
polku = "C:\oliodata.dat"
TsekkaaOlio
'Testi:
Olio(UBound(Olio)).value = UBound(Olio)
Olio(UBound(Olio)).state = True
Debug.Print "Olio(" & UBound(Olio) & _
").value = " & Olio(UBound(Olio)).value
End Sub
Sub TsekkaaOlio()
If Not Not Olio Then
If Olio(UBound(Olio)).state Then
If Dir(polku) <> "" Then
Kill polku
End If
Open polku For Binary Access Write As #1
Put #1, , Olio: Close #1
Dim newsize As Integer
newsize = UBound(Olio) + 1
Erase Olio: ReDim Olio(newsize)
Open polku For Binary Access Read As #1
Get #1, , Olio: Close #1
End If
Else
ReDim Olio(0)
End If
End SubTeet ReDim Preserven käyttämällä levyä välissä? Ei Preserven välttämisen tarvitse itsearvo olla. Aiemmassa keskustelussa Preserven välttämisellä tarkoitettiin sitä, että sitä kutsutaan harvemmin varaamalla valmiiksi enemmän muistia kerrallaan, joka parantaa suorituskykyä seurauksena siitä, että tavaraa tarvitsee liikutella muistissa harvemmin.
Esimerkissäsi suorituskyky heikkenee huomattavasti tiedon tallentuessa kovalevylle tai flashmuistille, vaikka se väistääkin Preserven käyttämisen.
Alla olevasta koodista puuttuu vielä kovalevylle tallentaminen, mutta olen lisännyt siihen pari Preserven kutsumista harventavaa tapaa. Vertailun vuoksi laitoin myös Collectionin kuvioihin mukaan.
Heippa taas!
tässä vielä taulukoidun olion swappaaminen osoittimesta...
Private Declare Function ArrayPtr Lib "msvbvm60" Alias _
"VarPtr" (Arr() As Any) As Long
Private Declare Sub GetByte Lib "msvbvm60" Alias _
"GetMem1" (ByRef inSrc As Any, ByRef inDst As Any)
Private Declare Sub PutMemberValue Lib "msvbvm60" Alias _
"PutMem4" (ByVal Ptr As Long, ByVal value As Any)
Private Declare Sub PutMemberState Lib "msvbvm60" Alias _
"PutMem4" (ByVal Ptr As Long, ByVal value As Boolean)
Private Type OlioType
value As Long
state As Boolean
End Type
Private Olio() As OlioType
Private Sub Command1_Click()
TsekkaaOlio
'Testi:
Olio(UBound(Olio)).value = UBound(Olio)
Olio(UBound(Olio)).state = True
Dim i As Integer
For i = LBound(Olio) To UBound(Olio)
Debug.Print "Olio(" & i & _
").value = " & Olio(i).value
Next
End Sub
Sub TsekkaaOlio()
If Not Not Olio Then
If Olio(UBound(Olio)).state Then
ReDim Temppi(UBound(Olio) + 1) As OlioType
GetByte ArrayPtr(Olio), ArrayPtr(Temppi)
Dim i As Integer
For i = LBound(Olio) To UBound(Olio)
PutMemberValue VarPtr(Temppi(i).value), Olio(i).value
PutMemberState VarPtr(Temppi(i).state), Olio(i).state
Next i
Olio = Temppi: Erase Temppi
End If
Else
ReDim Olio(0)
End If
End SubTässä threadissa kyllä konkretisoituu harvinaisen hyvin vanha totuus, että se mitä on mahdollista tehdä ei välttämättä ole sama asia kuin mitä kannattaa tehdä.
Sanohan muuta.
Nean kaksi edellistä koodia myös aiheuttavat ongelmia jos projektissa on muuta koodia, koska Not Not Olion jälkeen ei ole kutsuttu Debug.Assert App.hInstance
Helppo tapa saada virhe näkyville on lisätä heti TsekkaaOlion kutsumisen jälkeen vaikka MsgBox CLng(0.1), jolloin ei ilmestykään messagebox vaan virheilmoitus "Expression too complex". Käännetyssä ohjelmassa tosin ongelmaa ei ole, virhe on vain IDE:ssä ajettaessa.
Aihe on jo aika vanha, joten et voi enää vastata siihen.