dcsimg
Results 1 to 33 of 33

Thread: Using a Collection isn't doing what I would have expected

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Using a Collection isn't doing what I would have expected

    Code:
    Private Function Alive(CellNumber As Integer) As Boolean
     On Error Resume Next
     
     If LivingCells.Item(CellNumber) = CellNumber Then
       Alive = True
     End If
    End Function
    In the above function CellNumber is 1. The Collection LivingCells.Item(1) is empty so I would have thought that it would bypass the If statement but instead it entered the clause and set Alive to True. What am I doing wrong.

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    5,508

    Re: Using a Collection isn't doing what I would have expected

    What do you mean LivingCells.Item(1) is empty?
    It must exist or you would have gotten an "Invalid procedure call or argument" error.
    What did you add to the collection?
    Last edited by passel; Apr 1st, 2019 at 10:34 PM.

  3. #3
    Addicted Member
    Join Date
    Jun 2018
    Posts
    167

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by Code Dummy View Post
    [code]
    ...so I would have thought that it would bypass the If statement but instead it entered the clause and set Alive to True. What am I doing wrong.
    The reason why is you have not handled the error properly. See the below.

    Code:
    Private Function Alive(CellNumber As Integer) As Boolean
    
        On Error GoTo err
        If LivingCells.Item(CellNumber) = CellNumber Then Alive = True
        Exit Function
    err:
        Alive = False
    End Function

  4. #4
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    5,508

    Re: Using a Collection isn't doing what I would have expected

    Yeah, I totally ignored the OnErr line.
    So, it did error on the If condition, but you told it to ignore the error and continue with the next line which was "Alive = True".

    Telling your code to ignore errors and continue isn't a smart thing to do.

    As PGBSoft shows, rather than ignoring the error, the code deals with the error by branching to code to return a specific value when you get the error.
    I guess in this case where you don't get an error but you don't set Alive = True, then it defaults to being false, as PGBSofts function exits before reaching the Alive = False line in that case.
    So, the code could also be
    Code:
    Private Function Alive(CellNumber As Integer) As Boolean
      On Error GoTo err
      If LivingCells.Item(CellNumber) = CellNumber Then
        Alive = True
      End If
    err:
    End Function
    or, based on PGBSofts inline If Then
    Code:
    Private Function Alive(CellNumber As Integer) As Boolean
      On Error GoTo err
      If LivingCells.Item(CellNumber) = CellNumber Then Alive = True
    err:
    End Function
    Last edited by passel; Apr 1st, 2019 at 11:28 PM.

  5. #5
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,970

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by passel View Post
    Telling your code to ignore errors and continue isn't a smart thing to do
    That's Bull!
    Telling my code to ignore an error and to continue is a valid programming technique.
    But if i tell my code to ignore an error and to continue, and i don't check the Err-Number directly after my critical line, then (!!) it's an unsmart thing to do.
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,633

    Re: Using a Collection isn't doing what I would have expected

    There is no need for the unstructured error handling. This works fine:

    Code:
    Option Explicit
    
    Private LivingCells As Collection
    
    Private Function Alive(CellNumber As Integer) As Boolean
        On Error Resume Next
        Alive = LivingCells.Item(CellNumber) = CellNumber
    End Function
    
    Private Sub Form_Load()
        Set LivingCells = New Collection
        MsgBox Alive(1)
        LivingCells.Add 1
        MsgBox Alive(1)
        LivingCells.Remove 1
        MsgBox Alive(1)
    End Sub
    Yes, you have to understand how exception trapping works. This is obviously a very simple case where you won't need to check Err.Number, even though most of the time you would.
    Last edited by dilettante; Apr 2nd, 2019 at 03:23 AM.

  7. #7
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,801

    Re: Using a Collection isn't doing what I would have expected

    Personally, the following are a couple of procedures I have for dealing with collections. I have more advanced ones, but those get me through all the basics:

    Code:
    
    Public Function SafeGetCollItem(coll As Collection, Key As String, Optional Default As Variant = vbNullString) As Variant
        On Error GoTo NotInCollection
        SafeGetCollItem = coll.Item(Key)
        Exit Function
        '
    NotInCollection:
        SafeGetCollItem = Default
    End Function
    
    Public Sub SafeAddCollItem(coll As Collection, Value As Variant, Key As String)
        On Error GoTo AlreadyInCollection
        coll.Add Value, Key
    AlreadyInCollection:
    End Sub
    
    Public Function IsInCollection(coll As Collection, Key As String) As Boolean
        On Error GoTo NotInCollection
        IsObject coll.Item(Key)         ' The actual IsObject function is just used to retrieve the collection.  It doesn't matter if it's an object or not.
        IsInCollection = True
        Exit Function
        '
    NotInCollection:
    End Function
    
    

    Good Luck,
    Elroy
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  8. #8
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    5,508

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by Zvoni View Post
    That's Bull!
    Telling my code to ignore an error and to continue is a valid programming technique.
    But if i tell my code to ignore an error and to continue, and i don't check the Err-Number directly after my critical line, then (!!) it's an unsmart thing to do.
    Well, to my way of thinking, if you're checking the Err-Number, then you're not ignoring the error. That is what I was saying, ignoring the error without taking any action in regards to the error is not a smart thing to do.

  9. #9

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    Thanks, all, I think I understand now. However, elsewhere in my code I have this.....

    Code:
      '
      '
      On Error GoTo err1
      DeadCells.Add CellsAroundTarget(n), CStr(CellsAroundTarget(n))
      a = a + 1
    err1:
      On Error GoTo 0
      '
      '
    First time through the loop it adds the value of CellsAroundTarget(n) to DeadCells and a = 1. Second time through the loop it adds the next value of CellsAroundTarget(n) to DeadCells and a = 2. The third time through the loop CellsAroundTarget(n) is a duplicate value of the first time yet when it goes to add it, it errors out and I get an error message "Run-time error 457: This key is already associated with an element of this collection". Why didn't it got to err1 instead?

  10. #10
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,970

    Re: Using a Collection isn't doing what I would have expected

    Without seeing your whole loop it's guessing on my part, but my money is on the "On Error Goto 0" (instead of "resume")
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  11. #11
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,970

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by passel View Post
    Well, to my way of thinking, if you're checking the Err-Number, then you're not ignoring the error. That is what I was saying, ignoring the error without taking any action in regards to the error is not a smart thing to do.
    I agree partly!
    IF i have a line in a function, that might error out, and it's basically the last line in the function, i set an OERN and leave the code to run out of the function.
    Take Elroy's functions for example:
    In all three functions i'd use an OERN
    In his first function i'd set the result to default in the first line, and be done with it
    his second function: just an OERN at the start, and done (since his critical line is the last one)
    his third function again the same as the first:
    set result to false, and use the return-value of the IsObject-Call
    Code:
    Public Function IsInCollection(coll As Collection, Key As String) As Boolean
        On Error Resume Next
        IsInCollection = False
        IsInCollection =IsObject(coll.Item(Key))        ' The actual IsObject function is just used to retrieve the collection.  It doesn't matter if it's an object or not.
    End Function
    And you're done
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  12. #12

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by dilettante View Post
    There is no need for the unstructured error handling. This works fine:

    Code:
    Option Explicit
    
    Private LivingCells As Collection
    
    Private Function Alive(CellNumber As Integer) As Boolean
        On Error Resume Next
        Alive = LivingCells.Item(CellNumber) = CellNumber
    End Function
    
    Private Sub Form_Load()
        Set LivingCells = New Collection
        MsgBox Alive(1)
        LivingCells.Add 1
        MsgBox Alive(1)
        LivingCells.Remove 1
        MsgBox Alive(1)
    End Sub
    Yes, you have to understand how exception trapping works. This is obviously a very simple case where you won't need to check Err.Number, even though most of the time you would.
    This statement: Alive = LivingCells.Item(CellNumber) = CellNumber only works if it has Cstr: Alive = LivingCells.Item(CStr(CellNumber)) = CellNumber

  13. #13

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by Zvoni View Post
    Without seeing your whole loop it's guessing on my part, but my money is on the "On Error Goto 0" (instead of "resume")
    Resume doesn't work. I don't know what seeing the whole loop has to do with it but here it is.

    Code:
     For n = 1 To UBound(CellsAroundTarget)
       If n <> 5 Then 'cell 5 is the target cell
         If CellsAroundTarget(n) <= TotalCells Then
           For n2 = 0 To lstCurrentShape.ListCount - 1
             If lstCurrentShape.List(n2) = CellsAroundTarget(n) Then
               Counter = Counter + 1
             Else
               On Error GoTo err1
               DeadCells.Add CellsAroundTarget(n), CStr(CellsAroundTarget(n))
               a = a + 1
    err1:
               On Error GoTo 0
             End If
           Next n2
         End If
       End If
     Next n
    EDIT:

    OK, here is what I see happening

    1st time CellsAroundTarget(n) = 501 and it is added to collection
    2nd time CellsAroundTarget(n) = 501 again and it goes to err1 so it is not added to collection
    3rd time CellsAroundTarget(n) = 501 again and this is where it errors out. It does this every time
    Last edited by Code Dummy; Apr 2nd, 2019 at 12:33 PM.

  14. #14
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    12,946

    Re: Using a Collection isn't doing what I would have expected

    Why not check to see if it is there before adding it rather than blindly adding it and trying to ignore the error?

  15. #15
    Addicted Member
    Join Date
    Jun 2018
    Posts
    167

    Re: Using a Collection isn't doing what I would have expected

    Just a quick reply for you to check...

    Code:
    For n = 1 To UBound(CellsAroundTarget)
       If n <> 5 Then 'cell 5 is the target cell
         If CellsAroundTarget(n) <= TotalCells Then
           For n2 = 0 To lstCurrentShape.ListCount - 1
             If lstCurrentShape.List(n2) = CellsAroundTarget(n) Then
               Counter = Counter + 1
             Else
               On Error Resume Next
               DeadCells.Add CellsAroundTarget(n), CStr(CellsAroundTarget(n))
               If Err Then Err.Clear Else a = a + 1
             End If
           Next n2
         End If
       End If
     Next n

  16. #16
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    Pretty much every one of my previous responses to you have been ignored, so this is my last attempt to try to steer you in a more logical direction in your code.

    Ditch your single dimension array that you are using for board state. Since the cells in your board are organized in rows and columns, it is perfect for a two dimension array. Have two of them, one that stores the current generation of cells, and another that stores what the next generation of cells will look like. If you want to have a grid of 100x100, for example, have each dimension of the array allocated from 0 to 101 (I'll explain why below). Store a 1 in the array element if a cell is alive, store a 0 in the array element if a cell is not alive.

    Ditch any and all listboxes, ditch any and all collections. Ditch the code you just posted, it is crazy convoluted.

    All you need is something like the below:

    Code:
    'The reason to go from 1 to 100 in the for loops but the array dimensions go from 0 to 101 is so that there is a "border" of always dead cells around the outside of the board, so that there is no need to have any special code to accommodate cells that are in a "corner" or along the top, left, right, or bottom edges
    
    For intRows = 1 to 100
      For intCols = 1 to 100
        liveCells = GetLiveCells(intRows, intCols)
        'At this point, you know how many neighboring cells are alive, and you can get the alive/not alive status of the current cell via arrCurrent(intRows, intCols)
        'So here is where your If/Select Case/Whatever logic will go
        If current cell will be marked as live in next generation Then
          arrNext(intRows, intCols) = 1
        Else
          arrNext(intRows, intCols) = 0
        End If
      Next
    Next
    
    'At this point, arrNext contains the entire board state for the next generation
    'So you can update your game board, and then copy the values from arrNext to arrCurrent
    'And then repeat everything for as many or as few generations as you wish
    
    ...
    
    
    'This is all you need to do to get a count of the neighboring live cells
    
    Private Function GetLiveCells(intRow As Integer, intCol As Integer) As Integer
    
      'Add upper-left, above, upper-right, left, right, lower-left, below, and lower-right cell values to get alive neighbor count
      GetLiveCells = (arrCurrent(intRow-1, intCol-1) + arrCurrent(intRow-1, intCol) + arrCurrent(intRow-1, intCol+1) + arrCurrent(intRow, intCol-1) + arrCurrent(intRow, intCol+1) + arrCurrent(intRow+1, intCol-1) + arrCurrent(intRow+1, intCol) + arrCurrent(intRow+1, intCol+1))
    
    End Function
    Last edited by OptionBase1; Apr 2nd, 2019 at 01:30 PM.

  17. #17

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    @OptionBase1

    I really haven't ignored your previous post which the only one I can find is in the thread "Avoiding Duplicates' post #16. In that post I didn't see anything to really help me. What I read was that you have 600,000 cells, your using picturebox.PSet to draw each cell (or pixel), a 2D array to store the board state and a temp array that is as wide as the board but only two rows tall. That was very interesting indeed, but it didn't tell me anything about how to implement it so I went on to the other posts.

    OK, now that I have completed the two projects, one using Listboxes and the other using Collections which both work very well except for the slow down when there are many living cells (I'm talking hundreds of living cells constantly making new shapes) on the board I will now make an attempt to put together another project using the sample code you posted above (post #16). I'll probably have problems and will be asking a lot of questions

  18. #18
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    http://www.vbforums.com/showthread.p...=1#post5375343
    http://www.vbforums.com/showthread.p...=1#post5371845
    http://www.vbforums.com/showthread.p...=1#post5371893
    http://www.vbforums.com/showthread.p...=1#post5371919

    You say your code is slow. I'll ask yet again, how slow is slow? I gave the numbers about my code so that you could have something to compare against. Is a new generation taking several seconds (or more) to generate? Or are you expecting to get 50 generations per second and you are only seeing 5-10 and considering that to be slow? Details would be helpful.

    Another question, how are you drawing your board?

    The post in the other thread wasn't meant to be a lengthy guide to how to write a life sim, it was trying to get you to provide more details about what you are doing, and giving you some very generic insight into how I wrote code that does something similar to what you are doing.

    A lot of times, people make posts where all they do is post "I'm having trouble with the following code" - and after much prodding, it is found that the code was an attempt to solve a problem that can be solved in a much more efficient way using completely different code. I get the feeling that's where your posts have been. They are all focused in on getting some nuanced set of code to work properly, when in reality, you should likely be using completely different code to solve the bigger picture that you are working on. But outside of a few posts sprinkled here and there in your threads, you haven't done a good job explaining the bigger picture of what you are working on in your posts. I would guess that many people responding in your threads have no idea what it is exactly you are working on.

    All that being said, let me know once you get an implementation going of my suggested approach. And if you have any questions about that approach, I'm going to insist that you post all relevant code you are using before I can offer any assistance. Also, please post the ruleset of the game - when a living cells dies, when a non-living cell is born, when a cell stays as-is, etc.

    Good luck!

  19. #19
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    5,801

    Re: Using a Collection isn't doing what I would have expected

    Say Code Dummy ...

    Another thing that comes to mind here is that you can set up a system whereby both the rows and columns could be dynamically redimensioned. Here's some code I threw together:

    Code:
    
    Option Explicit
    
    Private Type RowType
        Data As Variant
        Col() As Variant
    End Type
    '
    Dim Row() As RowType
    '
    
    
    Private Sub Form_Load()
    
        ' Let's just set up a 5 (row) by 8 (column) grid to start.
    
        Dim r As Long
        Dim c As Long
    
        ReDim Preserve Row(1 To 5)                      ' "Preserve" used just to show that it could be.
        For r = LBound(Row) To UBound(Row)
            ReDim Preserve Row(r).Col(1 To 8)           ' "Preserve" used just to show that it could be.
        Next
    
        ' Now, let's just put some data into our dynamic arrays.
    
        For r = LBound(Row) To UBound(Row)
            Row(r).Data = r
            For c = LBound(Row(r).Col) To UBound(Row(r).Col)
                Row(r).Col(c) = c
            Next
        Next
    
    
        ' Now, let's dump the data.
    
        For r = LBound(Row) To UBound(Row)
            Debug.Print "Row "; Row(r).Data; " :       ";
            For c = LBound(Row(r).Col) To UBound(Row(r).Col)
                Debug.Print Row(r).Col(c);
            Next
            Debug.Print
        Next
    
    
    End Sub
    
    

    Now, the advantage there is that you're not using any objects, so there'll never be any slowdown caused by uninstantiating a bunch of stuff. The only slowdown would be if you didn't use ReDim Preserve in a smart way.

    I looked through the posts, and I still can't really get an idea of what you're trying to do. However, I'm assuming is some two-dimensional thing that might dynamically change size (on either rows or columns). What I've outlined above would give you that option.

    Another idea is that a Collection can actually contain another Collection, effectively creating a 2D collection. Or, you can also have an Array-Of-Collections. There are many options.

    Good Luck,
    Elroy

    EDIT1: I just use Variant for actually storing data, as I've got no idea what you'll be storing. Some other type may be more suitable for your needs.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

  20. #20

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    OptionBase1

    After taking a closer look at your code example it appears to me this is the about the same thing that I was doing when I first started this project. It was just taking too long to search through this huge array every time. My app was very slow even from the start. When I did away with the array and went to using Listboxes instead I noticed a tremendous increase in overall speed. I'm almost reluctant to even start again using your code but I guess I will just to see for myself. I do have three up front questions to ask for now.

    1) liveCells = GetLiveCells(intRows, intCols) - What am I supposed to do with variable liveCells?

    2) Where does CurrentCell come from?

    3) You have this comment:
    "At this point, you know how many neighboring cells are alive, and you can get the alive/not alive status of the current cell
    via arrCurrentGen(intRows, intCols)"

    Where does arrCurrentGen get it's values

  21. #21
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    1) That variable will tell you how many neighboring cells to the cell in question are live. So you use it to determine what happens to that cell in the next generation based on the game's rules.

    2) No idea what you are talking about, searching this page for "CurrentCell" gives me only one search result and that is from your post above.

    3) So, this is how I do it. I ask the user how many live cells should be randomly marked as "live" for the first generation. I call something like this and pass that value:

    Code:
    Private Sub GenerateGen1(intLiveCells As Integer)
    
      For i = 1 to intLiveCells
        intX = int(rnd*rows)+1
        intY = int(rnd*cols)+1
        arrCurrent(intX, intY) = 1
      Next i
    
    End Sub
    Note that this will almost certainly result in some of the same random coordinates being chosen to be made live, meaning if the user says to generate 10000 random live cells, something like 9678 may only be made live because of the duplication. I choose to accept that in my code, but there are ways around that that I'll leave up to you to code if you feel it is necessary. For all I know you might be letting the end user draw or choose their starting board state, or load it from a file, at which point all of the above for question 3 is moot anyway.

    After that, I just have a loop that generates the next generation, draws it, and updates the current generation array. Repeat, repeat, repeat.

  22. #22

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    your code example:

    Code:
    For intRows = 1 to 100
      For intCols = 1 to 100
        liveCells = GetLiveCells(intRows, intCols)
        'At this point, you know how many neighboring cells are alive, and you can get the alive/not alive status of the current cell via arrCurrent(intRows, intCols)
        'So here is where your If/Select Case/Whatever logic will go
        If current cell will be marked as live in next generation Then
          arrNext(intRows, intCols) = 1
        Else
          arrNext(intRows, intCols) = 0
        End If
      Next
    Next
    Where you wrote "If current cell ..." I thought you made a typo and you actually meant currentcell because you didn't put a comment comma in front of it so I made it the If statement...

    Code:
      '
      '
      If Alive(currentcell) Then ' will be marked as live in next generation Then
      '
      '
    So, since it was really a comment then I guess I need to supply my own variable, right

    OK, you first populate the board with random dots which there are good possibilities that several will touch and those that don't will die and then you try to make other shapes from the ones that didn't die on the initial toss, right

  23. #23
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    That If statement was basically me saying "This is where you add the code that determines if this cell that you are currently looking at will be living or not in the next generation, and once that determination is made, you either set the array element to 1 if it is alive, or to 0 if it is not".

    Also, you may have missed it, but I asked you to post the specific details of the game so I understand how it might differ from Conway's Life.

  24. #24
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    So, the rules for Conway's Game of Life are:

    A cell that has 0 or 1 living neighbors will be not alive in the next generation
    A cell with 2 living neighbors will keep its current status in the next generation (living stays alive, not living stays not living)
    A cell with 3 living neighbors will be alive in the next generation
    A cell with 4 or more living neighbors will be not alive in the next generation.

    I know in my example code above, I used the variable liveCells to store the number of living neighbors a cell has. A poor choice of a variable name on my part. So, the example below uses a more descriptive intLiveNeighbors instead.

    So, the If-Else version looks something like this:

    Code:
      If intLiveNeighbors <= 1 Then
        arrTemp(intX, intY) = 0
      ElseIf intLiveNeighbors = 2 Then
        arrTemp(intX, intY) = arrCurrent(intX, intY)
      ElseIf intLiveNeighbors = 3 Then
        arrTemp(intX, intY) = 1
      ElseIf intLiveNeighbors >= 4 Then
        arrTemp(intX, intY) = 0
      End If

  25. #25

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    I have seen several rules to the Game of Life and the rules I am using are slightly different than your rules. I'm not going to get into who has the correct rules as I don't think it really matters but the rules I'm using go like this:

    1) If a living cell has less than 2 living neighbors it will die in the next generation of lonliness. In other words it has 0 or 1 living neighbors
    2) If a living cell has less than 4 living neighbors it will live in the next generation. In other words it has 2 or 3 living neighbors
    3) If a living cell has 4 or more living neighbors it will die in the next generation because of over crowding
    4) If a dead cell has exactly 3 living neighbors it will be re-born in the next generation

    I see in above rules if a living cell has 2 living neighbors it will stay living but I don't see if a not living cell has 2 living neighbors it will stay not living

    When I use these rules all of my known shapes (shapes that I downloaded from the net) come out the same as what I saw on TV and on YouTube.

    Are you aware of the popular shape called a "glider". If you do know it then see if it goes through the generations like it's supposed to do using your rules. I'd like to see what happens. I can make my rules the same as yours and see how it comes out - maybe the same, maybe not
    Last edited by Code Dummy; Apr 3rd, 2019 at 01:16 AM.

  26. #26
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    5,508

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by Code Dummy View Post
    ...

    I see in above rules if a living cell has 2 living neighbors it will stay living but I don't see if a not living cell has 2 living neighbors it will stay not living
    ...
    Code:
      ElseIf intLiveNeighbors = 2 Then
        arrTemp(intX, intY) = arrCurrent(intX, intY)
    
    'ElseIf the current cell has exactly two neighbors Then
    '  The cell retains its current value  (if it is alive, it stays alive, if it is dead, it stays dead)
    p.s. It looks to me, that your set of rules and Options1's are the same, so match Conway's rules from the 1970s.

    i.e. your fourth rule matches his third. and his fourth, matches your third, so you end up with the same four.
    If a cell has exactly three neighbors, if it was dead it comes alive, but if it was alive it stays alive, so the end result is that it is alive regardless of its former state, so that is what the third If statement does, it sets the new generation cell to alive.

    In fact, unless there is some other value that number of neighbors can be, i.e. -1 as a border flag for instance, then the forth If could be an Else rather than an ElseIf since conditions 0,1,2 and 3 were covered. then the number of neighbors would have to be four or greater. But, without looking at the code, it is quite possible that a negative number might be used to flag border cells that aren't part of the game area, so the fourth If condition handles that implicitly.
    Last edited by passel; Apr 3rd, 2019 at 03:01 AM.

  27. #27
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    Quote Originally Posted by Code Dummy View Post
    I have seen several rules to the Game of Life and the rules I am using are slightly different than your rules. I'm not going to get into who has the correct rules as I don't think it really matters but the rules I'm using go like this:

    1) If a living cell has less than 2 living neighbors it will die in the next generation of lonliness. In other words it has 0 or 1 living neighbors
    2) If a living cell has less than 4 living neighbors it will live in the next generation. In other words it has 2 or 3 living neighbors
    3) If a living cell has 4 or more living neighbors it will die in the next generation because of over crowding
    4) If a dead cell has exactly 3 living neighbors it will be re-born in the next generation

    I see in above rules if a living cell has 2 living neighbors it will stay living but I don't see if a not living cell has 2 living neighbors it will stay not living

    When I use these rules all of my known shapes (shapes that I downloaded from the net) come out the same as what I saw on TV and on YouTube.

    Are you aware of the popular shape called a "glider". If you do know it then see if it goes through the generations like it's supposed to do using your rules. I'd like to see what happens. I can make my rules the same as yours and see how it comes out - maybe the same, maybe not
    The rules you state above are exactly the same as mine as passel points out.

    Yes, a glider works in my code, as well as all the blinkers, the glider gun, etc. Getting a glider to work is usually the first thing to do when creating a life sim to make sure the rule logic is correct.

    I wrote my first attempt at a Conway's Game of Life simulator in QBasic over 25 years ago, and I've got command line versions that I've written in C and C++, and GUI versions that I've written in VB 6.0, VB.NET, Java, Flash, and Borland C++ Builder.

  28. #28
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    You've not yet indicated how you are drawing your board, but one thing I do when I draw the next generation is, as I go through each cell, I look to see if a cell's state has changed.

    If a cell in the current generation stays in the same state in the next generation (stays alive or stays not alive), then graphically I need to do nothing for that cell when updating the board. If a cell in the current generation is different in the new generation (goes from alive to not alive or vice versa), only then do I update the board graphics for that cell.

    If you are just going through the board and graphically updating the new generation state for all cells without seeing if each cell actually changes, making that one change should improve performance noticeably.

  29. #29

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    Rather than explain how I do this or that I will just post the entire program

    Form Code

    Code:
    Dim RandomPatterns As Boolean
    Dim Running As Boolean
    Dim LivingCells As Collection
    Dim DeadCells As Collection
    
    Private Sub Form_Load()
     LoadCells
    
     Set LivingCells = New Collection
     Set DeadCells = New Collection
    
     RandomPatterns = False
     StopThis = True
     
     mnuGo.Enabled = True
     mnuSingleStep.Enabled = True
     mnuStop.Enabled = True
     mnuLoadPatterns.Enabled = True
     mnuShowGrid.Enabled = False
     mnuRemoveGrid.Enabled = True
     
     Me.Picture = imgGrid.Picture
     
     Caption = "Game of Life Ready"
    End Sub
    
    Private Sub Form_Resize()
     On Error Resume Next
     Me.Width = 19215: Me.Height = 10650
    End Sub
    
    Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
     Continue = True
    End Sub
    
    Private Sub Form_KeyPress(KeyAscii As Integer)
     Continue = True
    End Sub
    
    Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
     Continue = True
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
     ExitShow = True
    End Sub
    
    Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
     Dim n As Integer
     
     If Button = vbLeftButton Then
       If Alive(Index) Then
         Image1(Index).Picture = imgDead.Picture
         Image1(Index).Tag = "Dead"
    
         '---------------------------------------
         'On Error GoTo err1
         LivingCells.Remove (CStr(Index))
         'err1:
         '------------------------------------------
         
         For n = 0 To lstCurrentShape.ListCount - 1
           If lstCurrentShape.List(n) = CStr(Index) Then
             lstCurrentShape.RemoveItem (n)
           End If
         Next n
         
         Caption = "Cell = " & Index & ", Value = Dead"
       Else
         Image1(Index).Picture = imgAlive.Picture
         Image1(Index).Tag = "Alive"
         lstCurrentShape.AddItem Index
    
         '------------------------------------------
         'On Error GoTo err2
         LivingCells.Add Index, CStr(Index)
         'err2:
         '--------------------------------------------
         Caption = "Cell = " & Index & ", Value = Alive"
       End If
     End If
    End Sub
    
    Private Sub mnuClear_Click()
     Dim n As Integer
     
     For n = 1 To LivingCells.Count
       On Error Resume Next
       Image1(LivingCells.Item(n)).Picture = imgDead.Picture
       Image1(LivingCells.Item(n)).Tag = "Dead"
       On Error GoTo 0
     Next n
     
     Set LivingCells = New Collection
     Set DeadCells = New Collection
     
     For n = 0 To lstCurrentShape.ListCount - 1
       Image1(lstCurrentShape.List(n)).Picture = imgDead.Picture
       Image1(lstCurrentShape.List(n)).Tag = "Dead"
     Next n
     
     lstCurrentShape.Clear
    End Sub
    
    Private Sub mnuRemoveGrid_Click()
     mnuRemoveGrid.Enabled = False
     mnuShowGrid.Enabled = True
    
     Me.Picture = Nothing
    End Sub
    
    Private Sub mnuSavePattern_Click()
     Dim Pattern As String
     
     Dim n As Integer
     
     Pattern = ""
     
     For n = 1 To TotalCells
       If Alive(n) Then
         Pattern = Pattern & n & ","
       End If
     Next n
     
     Pattern = Left(Pattern, Len(Pattern) - 1) 'Trim off trailing comma
     
     Open App.Path & "\Untitled Pattern.txt" For Output As #1
     
     Print #1, Pattern
     
     Close #1
      
     MsgBox "Pattern saved as Untitled Pattern"
    End Sub
    
    Private Sub mnuShowGrid_Click()
     mnuRemoveGrid.Enabled = True
     mnuShowGrid.Enabled = False
     Me.Picture = imgGrid.Picture
    End Sub
    
    Private Sub mnuGo_Click()
     mnuSavePattern.Enabled = False
     mnuStop.Enabled = True
     mnuGo.Enabled = False
     mnuSingleStep.Enabled = False
    
     Running = True
    
     Caption = "Game of Life Running"
    
     StopThis = False
     
     Do While True
       DoEvents
       If StopThis Then
         Exit Sub
       End If
       
       mnuSingleStep_Click
     Loop
    End Sub
    
    Private Sub mnuSingleStep_Click()
     Dim n As Integer
     
     Set LivingCells = New Collection
     Set DeadCells = New Collection
     
     If Not Running Then
       Caption = "Game of Life Single Step"
     End If
     
     For n = 0 To lstCurrentShape.ListCount - 1
       Rule1AndRule2 lstCurrentShape.List(n)
     Next n
     
     For n = 1 To DeadCells.Count
       Rule3 DeadCells.Item(n)
     Next n
     
     DrawNextGeneration
    End Sub
    
    Private Sub mnuLoadPatterns_Click()
     Dim n As Integer
     
     Dim InputString As String
     
     Dim PatternCells() As String
     
     'Open App.Path & "\4-Way Gliders.pat" For Input As #1
     Open App.Path & "\2Gliders.pat" For Input As #1
       
     Do While Not EOF(1)
       Line Input #1, InputString
       PatternCells = Split(InputString, ",")
       
       For n = 0 To UBound(PatternCells)
         Image1(Val(PatternCells(n))).Picture = imgAlive.Picture
         Image1(Val(PatternCells(n))).Tag = "Alive"
         lstCurrentShape.AddItem PatternCells(n)
    
         On Error Resume Next
         LivingCells.Add PatternCells(n), CStr(PatternCells(n))
         If Err Then Err.Clear
       Next n
     Loop
     
     Close #1
    End Sub
    
    Private Sub mnuStop_Click()
     mnuSavePattern.Enabled = True
     mnuStop.Enabled = False
     mnuGo.Enabled = True
     mnuSingleStep.Enabled = True
     
     Caption = "Game of Life Stopped"
    
     Running = False
    
     StopThis = True
    End Sub
    
    Private Function GetCellsAroundTarget(CellNumber As Integer)
     CellsAroundTarget(1) = CellNumber - 83 - 1
     CellsAroundTarget(2) = CellNumber - 83
     CellsAroundTarget(3) = CellNumber - 83 + 1
     CellsAroundTarget(4) = CellNumber - 1
     CellsAroundTarget(6) = CellNumber + 1
     CellsAroundTarget(7) = CellNumber + 83 - 1
     CellsAroundTarget(8) = CellNumber + 83
     CellsAroundTarget(9) = CellNumber + 83 + 1
    End Function
    
    Private Function Alive(CellNumber As Integer) As Boolean
     On Error Resume Next
     Alive = LivingCells.Item(CStr(CellNumber)) = CellNumber
     If Err Then Err.Clear
    End Function
    
    Private Function Rule1AndRule2(Cell As Integer) As Boolean
     Dim Counter As Integer
     Dim n As Integer
     Dim n2 As Integer
     
     Counter = 0
     
     GetCellsAroundTarget Cell
     
     For n = 1 To UBound(CellsAroundTarget)
       If n <> 5 Then 'cell 5 is the target cell
         If CellsAroundTarget(n) <= TotalCells Then
           For n2 = 0 To lstCurrentShape.ListCount - 1
             If lstCurrentShape.List(n2) = CellsAroundTarget(n) Then
               Counter = Counter + 1
             Else
               On Error Resume Next
               DeadCells.Add CellsAroundTarget(n), CStr(CellsAroundTarget(n))
    
               If Err Then Err.Clear Else Image1(CellsAroundTarget(n)).Tag = "Dead"
             End If
           Next n2
         End If
       End If
     Next n
     
     Select Case Counter
       Case Is < 2     ' Target cell has 0 or 1 living neighbors - Cell dies of lonliness
         Rule1AndRule2 = False
         
         On Error Resume Next
         DeadCells.Add Cell, CStr(Cell)
         If Err Then Err.Clear Else Image1(Cell).Tag = "Dead"
       
       Case Is < 4     ' Target cell has 2 or 3 living neighbors - Cell stays alive
         Rule1AndRule2 = True
         
         On Error Resume Next
         LivingCells.Add Cell, CStr(Cell)
         If Err Then Err.Clear Else Image1(Cell).Tag = "Alive"
       
       Case Else       ' Target cell has 4 or more living neighbors - Cell dies of over crowding
         Rule1AndRule2 = False
         
         On Error Resume Next
         DeadCells.Add Cell, CStr(Cell)
         If Err Then Err.Clear Else Image1(Cell).Tag = "Dead"
     End Select
    End Function
    
    Private Function Rule3(DeadCellNumber As Integer) As Boolean
     Dim Counter As Integer
     Dim n As Integer
         
     Counter = 0
         
     GetCellsAroundTarget DeadCellNumber
     
     For n = 1 To UBound(CellsAroundTarget)
       '
       ' if CellsAroundTarget(n) is a dead square
       ' then see if it touches any three live squares
       '
       If n <> 5 Then
         For n3 = 0 To lstCurrentShape.ListCount - 1
           If lstCurrentShape.List(n3) = CellsAroundTarget(n) Then
             '
             ' Here if a living cell was found touching the dead cell
             '
             Counter = Counter + 1
           End If
         Next n3
       End If
     Next n
    
     If Counter = 3 Then
       '
       ' A dead cell is re-born
       '
       On Error Resume Next
       LivingCells.Add DeadCellNumber, CStr(DeadCellNumber)
       If Err Then Err.Clear Else Image1(DeadCellNumber).Tag = "Alive"
         
       Rule3 = True
     End If
    End Function
    
    Private Sub DrawNextGeneration()
     For n = 1 To DeadCells.Count
       Image1(DeadCells.Item(n)).Picture = imgDead.Picture
     Next n
    
     For n = 1 To LivingCells.Count
       Image1(LivingCells.Item(n)).Picture = imgAlive.Picture
     Next n
    
     lstCurrentShape.Clear
    
     For n = 1 To LivingCells.Count
       On Error Resume Next
       lstCurrentShape.AddItem LivingCells.Item(n)
       If Err Then Err.Clear
     Next n
    End Sub
    .BAS Module

    Code:
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       lParam As Any) As Long
    
    Public Const LB_FINDSTRINGEXACT = &H1A2
    
    Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    
    Public CellsAroundTarget(1 To 9) As Integer
    
    Public ExitShow As Boolean
    Public TotalCells As Integer
    
    Public PrevChecked As Integer
    
    Public Continue As Boolean
    Public StopThis As Boolean
    Public Sub LoadCells()
     Dim X As Integer, Y As Integer
     
     TotalCells = 1
      
     For X = 1 To 1265 Step 8
       For Y = 1 To 657 Step 8
         Load frmGameOfLife.Image1(TotalCells)
         frmGameOfLife.Image1(TotalCells).Move X, Y
         frmGameOfLife.Image1(TotalCells).BorderStyle = 0
         frmGameOfLife.Image1(TotalCells).Tag = "Dead"
         frmGameOfLife.Image1(TotalCells).Visible = True
         
         TotalCells = TotalCells + 1
       Next
     Next
    
     TotalCells = TotalCells - 1
    End Sub

  30. #30
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    So, am I reading that correct that you are using an array of image controls as your board, and you have a "live" and "dead" image that you load into the targeted image control based on the cell's state? Also, I see that you are loading the image to the targeted image control whether or not that image has changed. If you would only load the alive/dead status image in each image control if it has changed from the last generation, it would likely make your program much faster. You'll obviously need to have the ability to check the old vs. new generation status of each cell in your DrawNextGeneration routine in order to do so.

    I'll be honest, when I read your code I had to chuckle at your previous comment:

    After taking a closer look at your code example it appears to me this is the about the same thing that I was doing when I first started this project.
    I disagree, I think your code is quite convoluted and difficult to follow, and there are numerous inefficiencies. But my first attempt at writing a Conway's Life simulation was quite convoluted, difficult to follow, inefficient, and slow as well. Ce la vie.

    I think I've probably offered as much as I can to you for this. You've got your own version running, albeit slowly. Keep working at it and you should find ways to speed it up.

    Good luck!

  31. #31
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    Here is a stripped down version of kind of how I have it implemented. I just wrote it all from scratch, so it is not as efficient as my live code is. But it should give you an idea of how mine looks. This generates a board of 300x300, so 90000 cells, and will generate ~20000 live cells to begin with. I would be curious how this performs on your system compared to your own implementations.

    Building the form:

    Start a brand new project.

    Set the Form's ScaleMode property to Pixels. Make sure the form is wide and tall enough to contain the controls below.

    Add two buttons to the form. Command1 will be the Start button. Command2 will be the Stop button.

    Add a PictureBox called Picture1 to your form. Set the ScaleMode of Picture1 to Pixels. After that, set both the Width and the Height of Picture1 to 310 pixels.

    Then, paste in the following code:


    Code:
    Option Explicit
    
    Dim arrCurrent(301, 301) As Integer
    Dim arrTemp(301, 301) As Integer
    Const xB = 3
    Const yB = 3
    Dim blnPlaying As Boolean
    
    
    Private Sub Command1_Click()
    
      Randomize
      blnPlaying = True
      GenerateLife (20000)
      DrawBoard
      PlayLife
      
    End Sub
    
    Private Sub Command2_Click()
    
      blnPlaying = False
    
    End Sub
    
    Private Sub GenerateLife(intCells As Integer)
    
      Dim i As Integer
      
      For i = 1 To intCells
        arrCurrent(Int(Rnd * 300) + 1, Int(Rnd * 300) + 1) = 1
      Next i
    
    End Sub
    
    Private Sub DrawBoard()
    
      Dim x As Integer
      Dim y As Integer
      
      Picture1.Cls
      
      For y = 1 To 300
        For x = 1 To 300
          If arrCurrent(x, y) = 1 Then
            Picture1.PSet (x + xB, y + yB), vbBlack
          Else
            Picture1.PSet (x + xB, y + yB), vbWhite
          End If
        Next x
      Next y
            
    End Sub
    
    Private Sub PlayLife()
    
      Dim intNeighbors As Integer
      Dim x As Integer
      Dim y As Integer
      
      Do While blnPlaying = True
        For y = 1 To 300
          For x = 1 To 300
            intNeighbors = GetLiveCells(x, y)
            If intNeighbors <= 1 Then
              arrTemp(x, y) = 0
            ElseIf intNeighbors = 2 Then
              arrTemp(x, y) = arrCurrent(x, y)
            ElseIf intNeighbors = 3 Then
              arrTemp(x, y) = 1
            ElseIf intNeighbors >= 4 Then
              arrTemp(x, y) = 0
            End If
          Next x
        Next y
        
        For y = 1 To 300
          For x = 1 To 300
            If arrTemp(x, y) <> arrCurrent(x, y) Then
              If arrTemp(x, y) = 1 Then
                Picture1.PSet (x + xB, y + yB), vbBlack
              Else
                Picture1.PSet (x + xB, y + yB), vbWhite
              End If
            End If
            arrCurrent(x, y) = arrTemp(x, y)
          Next x
        Next y
        DoEvents
      Loop
      
    End Sub
    
    
    Private Function GetLiveCells(intRow As Integer, intCol As Integer) As Integer
    
      'Add upper-left, above, upper-right, left, right, lower-left, below, and lower-right cell values to get alive neighbor count
      GetLiveCells = (arrCurrent(intRow - 1, intCol - 1) + arrCurrent(intRow - 1, intCol) + arrCurrent(intRow - 1, intCol + 1) + arrCurrent(intRow, intCol - 1) + arrCurrent(intRow, intCol + 1) + arrCurrent(intRow + 1, intCol - 1) + arrCurrent(intRow + 1, intCol) + arrCurrent(intRow + 1, intCol + 1))
    
    End Function
    Last edited by OptionBase1; Apr 3rd, 2019 at 12:09 PM.

  32. #32

    Thread Starter
    Fanatic Member
    Join Date
    Apr 2017
    Posts
    550

    Re: Using a Collection isn't doing what I would have expected

    I know I need to do things to make it better but I am not a well educated VB programmer, as a matter of fact, I'm really somewhat of a beginner and I do the best I can at the time I write a program.

    Anyway, thanks for your help and I will continue to work on the project using your code snippet

    EDIT: I copied you stuff from post 31. Very impressive!
    Last edited by Code Dummy; Apr 3rd, 2019 at 12:24 PM.

  33. #33
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    825

    Re: Using a Collection isn't doing what I would have expected

    I can see how using a collection would be faster than an array, since in the array method like mine uses, I end up evaluating every cell (even in cases of a large area of all non-living cells), while a collection can just hold a reference to all of the living cells and all of the cells that surround a living cell and evaluate those, since the only way a cell can change state is if it is currently alive or if it is next to a cell that is currently alive.

    I guess I have a new version to write. Thanks for the insight!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width