Announcement

Collapse
No announcement yet.

Profile Alphabetizing function

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Profile Alphabetizing function

    Dave Roberts suggested a Profile of a program I'm working on. It's a nifty tool, and really easy to use. Here's a simple function to Alpha the results for easier reading.

    Code:
    Function Profile_Alpha(Profile_FileName As String) As Long
       Local ctr, fnum As Long
       Local lns(), s As String
    retry: 
      Try  'Wait until file is ready to be opened
        Open Profile_FileName For Binary As #fnum
      Catch
        Sleep 100
        GoTo retry
      End Try
     
     
       ctr = Lof(#fnum) 'how big
       s$ = Space$(ctr) 'create big string to get file
       Get #fnum, 1, s$ 'now get the file
       Close            'don't need it any more
     
       ctr = ParseCount(s$, $CrLf) 'How many lines
       Dim lns$(ctr) 'create array
       Parse s$, Lns$(), $CrLf  'Fill array
       Array Sort Lns$()       'Sort it
     
       Open Profile_FileName For Output As #fnum 'Re open to put sorted list
       For ctr = LBound(Lns$()) To UBound(Lns$())
         Print #fnum, lns$(ctr)    'put the line
       Next ctr
       Close
    '   Reset s$  ' testing maybe
    '   For ctr = Lbound(lns$()) To Lbound(lns$()) + 10
    '       s$ = s$ & lns(ctr) & $CrLf 
    '   Next ctr                       
    '   ?s$                            
    End Function          
    '
    'At the end of PBMain put this:
    '   Profile "c:\Program_Name.txt" 'Profile created here. Call it anything you want
    '   Profile_Alpha("c:\Program_Name.txt") 
    ' Applikation beenden
    Better Code found here: http://www.powerbasic.com/support/pb...ad.php?t=39112
    Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:47 PM. Reason: Forgot the Boundries
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

  • #2
    A nifty tool for a nifty tool.

    Instead of Sleep 5000
    Code:
    retry:
      Try
        Open Profile_FileName For Binary As #fnum
      Catch
        Sleep 100
        GoTo retry
      End Try
    I saw John Gleason use something similar the other week.
    Last edited by David Roberts; 10 Nov 2008, 10:31 PM. Reason: Spelling

    Comment


    • #3
      Originally posted by David Roberts View Post
      A nifty tool for a nifty tool.

      Instead of Sleep 5000
      Works a treat Dave. Code above updated.

      ==============================================
      Short is the joy that guilty pleasure brings.
      Euripides
      ==============================================
      Last edited by Gösta H. Lovgren-2; 10 Nov 2008, 11:04 PM.
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment


      • #4
        New and Improved

        To make the Profile more useful, the Procedures not called are not listed. And it's presented in 3 orders: Alpha, by Calls, and by Time spent in each Procedure
        Code:
        '
        '
        Function Profile_Alpha As Long
           Local Profile_FileName As String
           Local Order_Flag, clls, i, ctr, fnum As Long
           Local q_n1, q_n2 As Quad 
           Local n, u, Srt(), lns(), s As String                    
          Profile_FileName = CurDir$ & "\" & _ 'Exe.Path$ only returns 8 char Dos names so use CurDir$
                             Exe.Name$ & _ 'Progran running name
                             "_Profile.txt" 'Add a unique identifier to it
         
         Profile Profile_FileName 'create the file
        retry:
          Try    'Wait until file is ready to be opened
            Open Profile_FileName For Binary As #fnum
          Catch
            Sleep 100
            GoTo retry
          End Try
         
           ctr = Lof(#fnum) 'how big
           s$ = Space$(ctr) 'create big string to get file
           Get #fnum, 1, s$ 'now get the file
           Close            'don't need it any more
         
           ctr = ParseCount(s$, $CrLf) 'How many lines
           ReDim  srt$(ctr) 'create array
           Parse s$, srt$(), $CrLf  'Fill array
         
        '   'eliminate Procedures listed but not called
           For ctr = LBound(srt$()) To UBound(srt$())
               i = InStr(srt$(ctr), ",") 'find where Calls are
               clls = Val(Mid$(srt$(ctr), i + 1)) 'how many Calls to the Procedure
               If clls > 0 Then   'been called at least once
                  ReDim Preserve lns$(UBound(lns$()) + 1)  
                  lns$(UBound(lns$())) = srt$(ctr) 'put into Lns$()
               End If
           Next ctr
         
           'Format the output better
           u$ = "\" & Space$(40) & "\ " & _ 'should be plenty room for procedure name
                "  #,###,###,### " & _ 'Billion should be enough for calls to
                "  ##,###,###,### "    '10 billion
           For ctr = LBound(Lns$()) To UBound(Lns$())
                s$ = lns$(ctr) 'easier to work with
                i = InStr(s$, ",") 'find end of name
                  n$ = MCase$(Left$(s$, i-1)) 'I hate all CAPS
                  q_n1 = Val(Mid$(s$, i+2)) ' number of Calls
                i = InStr(i + 2, s$, ",") 'find end of Calls
                  q_n2 = Val(Mid$(s$, i+2)) 'Time Spent
               lns$(ctr) = Using$(u$, n$, q_n1, q_n2)   
           Next ctr
         
           'now start over wih shorter list
           ReDim srt$(UBound(Lns$()))
           For ctr = LBound(Lns$()) To UBound(Lns$())
              srt$(ctr) = lns$(ctr) & Using$("  ######", ctr) 'add an index. 6 number spaces should be plenty
           Next ctr
         
           Open Profile_FileName For Output As #fnum 'Re open to put sorted list
           s$ = "Alphabetical by Procedure" 'title
             Order_Flag = 1
             GoSub Put_Profile 'Alpha by Procedure
         
           'Now list by Number of Calls
           For ctr = LBound(Lns$()) To UBound(Lns$()) 
               i = InStr(srt$(ctr), ",") 'find where Calls are
               clls = Val(Mid$(srt$(ctr), i + 1)) 'how many Calls to the Procedure
               srt$(ctr) = Using$("#######", clls) & _ 'number in front for sorting
                           srt$(ctr) 'the line
           Next ctr
           s$ = "In Call frequency order" 
             Order_Flag = -1
             GoSub Put_Profile 'Alpha by Procedure
           'Now list by Time used
           For ctr = LBound(Lns$()) To UBound(Lns$()) 
               i = InStr(srt$(ctr), ",") 'find where Calls are
                 i = InStr(i + 1, srt$(ctr), ",") 'find where Time is
               clls = Val(Mid$(srt$(ctr), i + 1)) 'how time is spent in the Procedure
               srt$(ctr) = Using$("##########", clls) & _ 'number in front for sorting
                           srt$(ctr) 'the line
           Next ctr
           s$ = "In Time Used order" 
             Order_Flag = -1
             GoSub Put_Profile 'Alpha by Procedure
        '   Reset s$  'JIC for testing maybe
        '   For ctr = 1 To 10
        '       s$ = s$ & lns(ctr) & $CrLf 
        '   Next ctr                       
        '   ?s$                            
        Exit Function 'Der Funkshunboten beenden         
        '
        Put_ProFile:
           Local Strt, Dun, Stp As Long
           Array Sort srt$()  'put in order    
          Print #fnum,,, s$  'title
          Print #fnum, "     Procedure" & Space$(36) &  "Calls to" & Space$(2) & "Time Spent here" 'headers
         If Order_Flag = -1 Then 'Last To first
            Strt = UBound(Lns$()) 
            Dun = LBound(Lns$())          
            stp = -1
          Else  'first to last
            Strt = LBound(Lns$()) 
            Dun = UBound(Lns$()) 'regular order         
            stp = 1
         End If
           For ctr = Strt To Dun Step stp 'Procedure order         
              i = Val(Right$(srt$(ctr), 5)) 'get the index to Lns$()
              If Len(lns$(i)) > 2 Then 'not blank
                Print #fnum, lns$(i)    'put the line
              End If
           Next ctr
           Print #fnum, " " 'blank line
         
         Return
        End Function
        'At the end of PBMain put this line:
        ' Profile_Alpha  'Applikashunfurstunkenorder
        Better Code found here: http://www.powerbasic.com/support/pb...ad.php?t=39112

        ============================================================
        "A mathematician is a device
        for turning coffee into theorems."
        Paul Erdos (1913-1996)
        ============================================================
        Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:48 PM.
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


        • #5
          You are on a roll Gösta.
          Code:
          Profile Exe.Name$ + "_Profile.txt"
          Profile_Alpha(Exe.Name$ + "_Profile.txt")
          With regard Life the above will find "Life_Profile.txt" in Life's directory.

          Comment


          • #6
            The output needs tidying up.

            When you've kicked it around a while this should end up in the Source Code forum. With large profiles it is sometimes difficult to see the wood from the trees - your app will help a great deal.

            Comment


            • #7
              Your wish is my desire, Sire.

              http://www.powerbasic.com/support/pb...ad.php?t=39112
              ============================================
              "The President has kept all of the promises
              he intended to keep."
              Clinton aide George Stephanopolous
              speaking on Larry King Live
              ============================================
              Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:49 PM. Reason: Changed inappropriate address to the Proper One
              It's a pretty day. I hope you enjoy it.

              Gösta

              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

              Comment


              • #8
                Curse you Dave Roberts! I got so escited by your flagrant flattery I posted the code before it was ready... and didn't notice until after I posted. Now you caused me to stay up way after past beddy bye. I just hope I'm not not all crusty and cranky tomorrow. Well, my wife hopes so anyway. And of course, if she ain't happy. Well .. it sorta turns into a vicious circle, if you know what I mean. And I guess you can guess how that's gonna turn our for me, her being lineman big and linebacker mean and all.

                Oh well. it's ready now (I hope) http://www.powerbasic.com/support/pb...ad.php?t=39112

                Introducing the formatted number fields with commas played with my head for awhile. 9,300 was Val'ing to 9 but the list was so long, I didn't notice it before I posted the first time.

                One neat thing I "disovered" was Mcase$ treats the underscore "_" as a space. Cool for me, because I use it a lot.

                Here a sample printout :
                Code:
                Alphabetical by Procedure Name Ran 5 seconds
                Procedure Calls to ms Spent here Seconds
                1) Add_Colonies 2 1,000 1 
                2) Add_Glider 2 219 0 
                3) Center_Line 51 93 0 
                4) Default_Settings 1 2,375 2 
                 
                In Call frequency order Ran 5 seconds
                Procedure Calls to ms Spent here Seconds
                1) Get_Inkey 559,029 906 1 
                2) Pattern_Soccer_Ball 232 0 0 
                3) Grproc 228 0 0 
                4) Makegun 118 0 0 
                 
                In Time Used order Ran 5 seconds
                Procedure Calls to ms Spent here Seconds
                1) Default_Settings 1 2,375 2 
                2) Update_Gary 116 1,267 1 
                3) Start_New 1 1,219 1
                Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:50 PM.
                It's a pretty day. I hope you enjoy it.

                Gösta

                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                Comment


                • #9
                  > flagrant flattery

                  That is something I don't get accused of very often - it worked though.

                  In Version 2 you may like to consider ordering 'Time Used/Call'. <cough>

                  Comment


                  • #10
                    Originally posted by David Roberts View Post
                    > flagrant flattery

                    That is something I don't get accused of very often - it worked though.
                    Will have to try it on my wife today. Maybe in semaphore, she doesn't seem too ... uuuhhh .. talkative so far {grin}. Hope it's not the calm before the storm. {shudder}

                    In Version 2 you may like to consider ordering 'Time Used/Call'. <cough>
                    Example, please?

                    =========================================
                    "I've had a perfectly wonderful evening.
                    But this wasn't it."
                    Groucho Marx
                    =========================================
                    Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:51 PM.
                    It's a pretty day. I hope you enjoy it.

                    Gösta

                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                    Comment


                    • #11
                      > Example, please?

                      Header_Print would give 15.685ms/call
                      Header_Set would give 15.651ms/call
                      Default_Settings would give 4390ms/call
                      ...
                      ..
                      ...
                      Center_Line would give 15ms/call

                      Header_Set and Center_Line take about the same time/call but tweaking Header_Set would give the greater benefit as it is called nearly 18 times more often then Center_Line.

                      Code:
                                             In Time Used order  Ran 306 seconds
                                Procedure                                       Calls to    ms Spent here     Seconds
                           1) Header_Print                                           883           13,850          14 
                           2) Header_Set                                             879           13,757          14 
                           3) Default_Settings                                         1            4,390           4 
                           4) Get_Inkey                                        1,985,089            1,781           2 
                           5) Rules_Print                                              1            1,453           1 
                           6) Opening_Screen                                           1            1,438           1 
                           7) Add_Colonies                                             2            1,031           1 
                           8) Center_Line                                             49              735           1 
                           9) Add_Glider                                               2              250           0 
                          10) Update_With_All_Pointers                             9,670               32           0 
                          11) Header_Msg                                               2               31           0 
                          12) Draw_Grid                                            9,670               16           0 
                          13) Grproc                                               9,932                0           0 
                          14) Stasis_Check                                         9,671                0           0 
                          15) Population_Unchanged                                 9,671                0           0 
                          16) Pixel_Color_Set                                      9,671                0           0 
                          17) Mouse_Click_Check                                    9,671                0           0 
                          18) Gen_Total_Set                                        9,671                0           0 
                          19) Wrap_Horizontally                                    9,670                0           0 
                          20) Time_Elapsed                                           895                0           0 
                          21) Reset_Sum_Ctr_Array                                     27                0           0 
                          22) Stasis_Point_Set                                        18                0           0 
                          23) Stasis_Accumulate                                       16                0           0 
                          24) Random_W_H                                               3                0           0 
                          25) Makegun                                                 92                0           0 
                          26) Var_Ptrs_Set                                             1                0           0 
                          27) Rules_Set                                                1                0           0 
                          28) Profile_Ordered                                          1                0           0 
                          29) Pbmain                                                   1                0           0 
                          30) Pattern_Soccer_Ball                                      1                0           0 
                          31) Pattern_Crown                                            1                0           0 
                          32) Font_Set                                                 1                0           0
                      As your app stands it would take a lot of work programmatically and computationally to get time/call but may be easier if two arrays were created: A string array holding the procedure name and a three dimensional numeric array holding calls, time and a calculated time/call and the two arrays may be tagged.
                      Last edited by David Roberts; 12 Nov 2008, 12:57 PM.

                      Comment


                      • #12
                        Originally posted by David Roberts View Post
                        > Example, please?

                        Header_Print would give 15.685ms/call
                        Header_Set would give 15.651ms/call
                        Default_Settings would give 4390ms/call
                        ...
                        .As your app stands it would take a lot of work programmatically and computationally to get time/call but may be easier if two arrays were created: A string array holding the procedure name and a three dimensional numeric array holding calls, time and a calculated time/call and the two arrays may be tagged.
                        How's about this?
                        Code:
                                      Profile for C:\Only_My_Programs\Life\Life_Profile.txt
                                      11-12-2008   Ran from 22:11:47 to 22:21:18 for 572 seconds
                                                    Alphabetical by Procedure Name
                                           Procedure       Calls to    ms Spent here     Seconds      Avg
                             1)         Add_Colonies             12            6,031           6   502.58 
                             2)           Add_Glider             43            4,438           4   103.21 
                             3)          Center_Line             51               94           0     1.84 
                             4)     Default_Settings              1            4,812           5  ------- 
                             5)            Draw_Grid         23,318           14,606          15     0.63 
                             6)             Font_Set              1                0           0  ------- 
                             7)        Gen_Total_Set         23,319           24,007          24     1.03 
                             8)            Get_Inkey      1,930,045           12,188          12     0.01 
                             9)               Grproc         24,132              218           0     0.01 
                            10)           Header_Msg              2               16           0     8.00 
                            11)         Header_Print          2,172            6,076           6     2.80 
                            12)           Header_Set          2,120            6,470           6     3.05 
                            13)              Makegun         23,361              110           0     0.00 
                            14)    Mouse_Click_Check         23,319                0           0     0.00 
                            15)       Opening_Screen              1            2,922           3  ------- 
                            16)  Pattern_Soccer_Ball         46,636                0           0     0.00 
                            17)               Pbmain              1                0           0  ------- 
                            18)      Pixel_Color_Set         23,319               16           0     0.00 
                            19) Population_Unchanged         23,319               15           0     0.00 
                            20)      Profile_Ordered              1                0           0  ------- 
                            21)           Random_W_H             12                0           0     0.00 
                            22)  Reset_Sum_Ctr_Array             66                0           0     0.00 
                            23)          Rules_Print              1              641           1  ------- 
                            24)            Rules_Set              1                0           0  ------- 
                            25)    Sayings_Data_Load              1               94           0  ------- 
                            26)        Sayings_Print         23,318            5,070           5     0.22 
                            27)         Spacebar_Msg              1            1,094           1  ------- 
                            28)            Start_New              1            1,203           1  ------- 
                            29)    Stasis_Accumulate              7                0           0     0.00 
                            30)         Stasis_Check         23,319                0           0     0.00 
                            31)     Stasis_Point_Set              9                0           0     0.00 
                            32)         Time_Elapsed          2,122                0           0     0.00 
                            33)          Update_Gary         23,318          459,285         459    19.70 
                            34)         Var_Ptrs_Set              1                0           0  ------- 
                            35)    Wrap_Horizontally         23,318           24,894          25     1.07 
                         
                                                    In Call frequency order
                                           Procedure       Calls to    ms Spent here     Seconds      Avg
                             1)            Get_Inkey      1,930,045           12,188          12     0.01 
                             2)  Pattern_Soccer_Ball         46,636                0           0     0.00 
                             3)               Grproc         24,132              218           0     0.01 
                             4)              Makegun         23,361              110           0     0.00 
                             5)         Stasis_Check         23,319                0           0     0.00 
                             6) Population_Unchanged         23,319               15           0     0.00 
                             7)      Pixel_Color_Set         23,319               16           0     0.00 
                             8)    Mouse_Click_Check         23,319                0           0     0.00 
                             9)        Gen_Total_Set         23,319           24,007          24     1.03 
                            10)    Wrap_Horizontally         23,318           24,894          25     1.07 
                            11)          Update_Gary         23,318          459,285         459    19.70 
                            12)        Sayings_Print         23,318            5,070           5     0.22 
                            13)            Draw_Grid         23,318           14,606          15     0.63 
                            14)         Header_Print          2,172            6,076           6     2.80 
                            15)         Time_Elapsed          2,122                0           0     0.00 
                            16)           Header_Set          2,120            6,470           6     3.05 
                            17)  Reset_Sum_Ctr_Array             66                0           0     0.00 
                            18)          Center_Line             51               94           0     1.84 
                            19)           Add_Glider             43            4,438           4   103.21 
                            20)           Random_W_H             12                0           0     0.00 
                            21)         Add_Colonies             12            6,031           6   502.58 
                            22)     Stasis_Point_Set              9                0           0     0.00 
                            23)    Stasis_Accumulate              7                0           0     0.00 
                            24)           Header_Msg              2               16           0     8.00 
                            25)         Var_Ptrs_Set              1                0           0  ------- 
                            26)            Start_New              1            1,203           1  ------- 
                            27)         Spacebar_Msg              1            1,094           1  ------- 
                            28)    Sayings_Data_Load              1               94           0  ------- 
                            29)            Rules_Set              1                0           0  ------- 
                            30)          Rules_Print              1              641           1  ------- 
                            31)      Profile_Ordered              1                0           0  ------- 
                            32)               Pbmain              1                0           0  ------- 
                            33)       Opening_Screen              1            2,922           3  ------- 
                            34)             Font_Set              1                0           0  ------- 
                            35)     Default_Settings              1            4,812           5  ------- 
                         
                                                    In Time Used order
                                           Procedure       Calls to    ms Spent here     Seconds      Avg
                             1)          Update_Gary         23,318          459,285         459    19.70 
                             2)    Wrap_Horizontally         23,318           24,894          25     1.07 
                             3)        Gen_Total_Set         23,319           24,007          24     1.03 
                             4)            Draw_Grid         23,318           14,606          15     0.63 
                             5)            Get_Inkey      1,930,045           12,188          12     0.01 
                             6)           Header_Set          2,120            6,470           6     3.05 
                             7)         Header_Print          2,172            6,076           6     2.80 
                             8)         Add_Colonies             12            6,031           6   502.58 
                             9)        Sayings_Print         23,318            5,070           5     0.22 
                            10)     Default_Settings              1            4,812           5  ------- 
                            11)           Add_Glider             43            4,438           4   103.21 
                            12)       Opening_Screen              1            2,922           3  ------- 
                            13)            Start_New              1            1,203           1  ------- 
                            14)         Spacebar_Msg              1            1,094           1  ------- 
                            15)          Rules_Print              1              641           1  ------- 
                            16)               Grproc         24,132              218           0     0.01 
                            17)              Makegun         23,361              110           0     0.00 
                            18)          Center_Line             51               94           0     1.84 
                            19)    Sayings_Data_Load              1               94           0  ------- 
                            20)      Pixel_Color_Set         23,319               16           0     0.00 
                            21)           Header_Msg              2               16           0     8.00 
                            22) Population_Unchanged         23,319               15           0     0.00 
                            23)  Pattern_Soccer_Ball         46,636                0           0     0.00 
                            24)         Stasis_Check         23,319                0           0     0.00 
                            25)    Mouse_Click_Check         23,319                0           0     0.00 
                            26)         Time_Elapsed          2,122                0           0     0.00 
                            27)  Reset_Sum_Ctr_Array             66                0           0     0.00 
                            28)           Random_W_H             12                0           0     0.00 
                            29)     Stasis_Point_Set              9                0           0     0.00 
                            30)    Stasis_Accumulate              7                0           0     0.00 
                            31)         Var_Ptrs_Set              1                0           0  ------- 
                            32)            Rules_Set              1                0           0  ------- 
                            33)      Profile_Ordered              1                0           0  ------- 
                            34)               Pbmain              1                0           0  ------- 
                            35)             Font_Set              1                0           0  -------

                        ============================================================
                        "I would have made a good Pope."
                        Richard M. Nixon (1913-1994)
                        ============================================================


                        (Source Code Forum updated)
                        Last edited by Gösta H. Lovgren-2; 12 Nov 2008, 09:23 PM.
                        It's a pretty day. I hope you enjoy it.

                        Gösta

                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                        Comment


                        • #13
                          You beat me to it, Gösta.

                          I couldn't get my head around those strings, so broke then down into a bunch of arrays. The end result is the same, just a different perspective.

                          Now add a sort "In Time per Call order" and we are even.

                          Comment


                          • #14
                            Originally posted by David Roberts View Post
                            You beat me to it, Gösta.

                            I couldn't get my head around those strings, so broke then down into a bunch of arrays.
                            Gee, I commented everything well enough so anybody could follow along, I thought pretty clearly but I guess not. (Not being smart, just musing.) If there is anything you don't understand I'd be happy, even eager, to explain. I've always found explaining something/anything to someone else nearly always clarifies my thinking.

                            The end result is the same, just a different perspective.
                            Let's see your perspective.
                            Now add a sort "In Time per Call order" and we are even.
                            Not a problem to do but really seems overkill. Only a couple minutes to add it really (just to C&P a For/Next). The TpC pretty much stands out in the third listing "Time Used Order" I think.
                            It's a pretty day. I hope you enjoy it.

                            Gösta

                            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                            Comment


                            • #15
                              Gee, I commented everything well enough so anybody could follow along, I thought pretty clearly but I guess not.
                              Not at all, Gösta. Instead of "I couldn't get my head around those strings" I should have written "I cannot get my head around strings".

                              Let's see your perspective.
                              Rather than re-invent the wheel I've pinched some of your output stuff and the output still needs some work on it.

                              Anyway, I'll post what has been done so far. As you can see I'm thinking in arrays as opposed to strings.

                              Code:
                                Macro Unsort(x) = Array Sort SortPtr(), TagArray x
                              
                                Function Profile_Ordered(Profile_Start_Time As Long) As Long
                              
                                Local sFile As String, ctr, i, k, del, hrs, mins, secs As Long
                                Dim ArrayProc() As String
                                Dim ArrayCalls() As Long
                                Dim ArrayTime() As Long
                                Dim ArrayTimePerCall() As Single
                                Dim SortPtr() As Long
                                Local Profile_FileName As String
                                
                                Profile_FileName = CurDir$ & "\" & _ 'Exe.Path$ only returns 8 char Dos names so use CurDir$
                                                     Exe.Name$ & _ 'Progran running name
                                                     "_Profile.txt" 'Add a unique identifier to it
                                
                                Profile Profile_FileName 'create the file
                              
                              retry:
                                Try
                                  Open "LifeP.txt" For Binary As #1
                                Catch 
                                  Sleep 100
                                  GoTo retry
                                End Try
                                
                                sFile = Space$(Lof(#1))
                                Get #1,, sFile
                                Close
                                
                                ctr = ParseCount( sFile, $CrLf )
                                ReDim ArrayProc( 1 To ctr)
                                Parse sFile, ArrayProc(), $CrLf
                                ReDim ArrayCalls( 1 To ctr)
                                ReDim ArrayTime( 1 To ctr)
                                For i = 1 To ctr
                                  ArrayCalls(i) = Val(Parse$( ArrayProc(i), 2 ))
                                  ArrayTime(i) = Val(Parse$( ArrayProc(i), 3 ))
                                Next
                                For i = 1 To ctr
                                  ArrayProc(i) = Parse$( ArrayProc(i), 1 )
                                Next
                                
                                ' Shift down the zero call entries
                                i = 1
                                del = 0
                                Do
                                  Array Scan ArrayCalls(i), =0, To k
                                  If k = 0 Then Exit Loop
                                  Array Delete ArrayCalls(i+k-1), -1
                                  Array Delete ArrayTime(i+k-1)
                                  Array Delete ArrayProc(i+k-1)
                                  Incr del
                                  i = i+k-1
                                Loop
                                ' and remove them
                                ctr = ctr - del
                                ReDim Preserve ArrayProc( 1 To ctr )
                                ReDim Preserve ArrayCalls( 1 To ctr )
                                ReDim Preserve ArrayTime( 1 To ctr )
                                
                                ' Calc the time/call
                                ReDim ArrayTimePerCall( 1 To ctr )
                                For i = 1 To ctr
                                  ArrayTimePerCall(i) = Int(ArrayTime(i)*1000/ArrayCalls(i))/1000
                                Next
                                
                                ReDim SortPtr( 1 To ctr ) ' a work around for not being able to have more then one TagArray per statement
                                For i = 1 To ctr: SortPtr(i) = i: Next
                                
                                Open Profile_FileName For Output As #1
                                
                                  hrs = Profile_Start_Time \ 3600
                                  mins = (Profile_Start_Time  - (hrs * 3600)) \ 60
                                  secs = (Profile_Start_Time -  (hrs * 3600)) - (mins * 60)
                               
                                  Print #1,, "Profile for " &  Profile_FileName 
                                  Print #1,, Date$ & "   Ran from " & _
                                             Using$("##:##:## to ", hrs, mins, secs) & _
                                             Time$ & _
                                             Using$(" for #, seconds", Timer - Profile_Start_Time) 
                                  
                                  Print #1: Print #1, "Alphabetical by Procedure Name       Calls    Tot ms       ms/call":Print #1
                                  Array Sort ArrayProc(), TagArray SortPtr()
                                  For i = 1 To ctr
                                    Print #1, Using$("##",i);") ";ArrayProc(i);Space$(30-Len(ArrayProc(i)));Using$("########",ArrayCalls(SortPtr(i)));Space$(6); _
                                    Using$("####",ArrayTime(SortPtr(i)));Space$(6);Using$("####.###",ArrayTimePerCall(SortPtr(i)))
                                  Next
                                  Unsort( ArrayProc() ) ' Release global tagging to ArrayProc
                                  
                                  Print #1: Print #1, "In call frequency order             Calls    Tot ms       ms/call": Print #1
                                  Array Sort ArrayCalls(), TagArray SortPtr(), Descend
                                  For i = 1 To ctr
                                    Print #1, Using$("##",i);") ";ArrayProc(SortPtr(i));Space$(30-Len(ArrayProc(SortPtr(i)))); Using$("#######",ArrayCalls(i)); _
                                    Space$(6);Using$("####",ArrayTime(SortPtr(i)));Space$(6);Using$("####.###",ArrayTimePerCall(SortPtr(i)))
                                  Next
                                  Unsort( ArrayCalls() ) ' Release global tagging to ArrayCalls
                                
                                  Print #1: Print #1, "In time used order                  Calls    Tot ms       ms/call": Print #1
                                  Array Sort ArrayTime(), TagArray SortPtr(), Descend
                                  For i = 1 To ctr
                                    Print #1, Using$("##",i);") ";ArrayProc(SortPtr(i));Space$(30-Len(ArrayProc(SortPtr(i))));Using$("#######",ArrayCalls(SortPtr(i))); _
                                    Space$(6);Using$("####",ArrayTime(i));Space$(6);Using$("####.###",ArrayTimePerCall(SortPtr(i)))
                                  Next
                                  Unsort( ArrayTime() ) ' Release global tagging to ArrayTime
                                
                                  Print #1: Print #1, "In Time per call order              Calls    Tot ms       ms/call": Print #1
                                  Array Sort ArrayTimePerCall(), TagArray SortPtr(), Descend
                                  For i = 1 To ctr
                                    Print #1, Using$("##",i);") ";ArrayProc(SortPtr(i));Space$(30-Len(ArrayProc(SortPtr(i))));Using$("#######",ArrayCalls(SortPtr(i))); _
                                    Space$(6);Using$("####",ArrayTime(SortPtr(i)));Space$(6);Using$("####.###",ArrayTimePerCall(i))
                                  Next
                                
                                Close #1
                              
                              End Function
                              Last edited by David Roberts; 13 Nov 2008, 01:54 PM.

                              Comment


                              • #16
                                Your code looks a lot cleaner, Dave, though not as easy for me to understand right off the bat. (Different ways of thinking about the same thing). I'll play with it a little so I can grasp it better and if I can, I['ll replace the code on the Sorcerer Forum with your.

                                If okay with you that is.

                                ===============================================
                                "The concept is interesting and well-formed,
                                but in order to earn better than a 'C',
                                the idea must be feasible."
                                A Yale University management professor
                                in response to student Fred Smith's paper
                                proposing reliable overnight delivery service
                                (Smith went on to found Federal Express Corp.)
                                ===============================================
                                It's a pretty day. I hope you enjoy it.

                                Gösta

                                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                Comment


                                • #17
                                  If okay with you that is.
                                  Of course it is. The 'Profile Creator Function' is your baby and whatever I drop into these forums may be used without talking with me first; that's what makes these forums such a terrific resource.

                                  I've added a macro to the above to aid readability and employed it at the end of a Sort block instead of at the beginning of the next Sort block as it is associated with the preceding block. A bit of a mouthful but you'll see what I mean.

                                  Comment


                                  • #18
                                    Okay, got back to it tonight. First off your code IS a lot cleaner, Dave. (Good job). Frankly, I never really used all of the Commands in available in PB. (Array Delete, Array Scan, Parse$, ...). Always did it the old fashioned clumsy brute force way. And using multiple arrays is better (easier to understand/follow) now that I've looked at further. Plus Macros make a lot of sense. I was initially trying to avoid them as I wanted everything contained in one function but now I see it's just as easy to use them. Way easier in fact. (I do think probably a Typed Array would be even better again. More on that later)

                                    Okay enough (returned) flattery. I got a problem. Either Profile's got {shudder} an insect or I got clouds over my eyes.

                                    The total for ArrayTime() does not add up. Either my calculated time is WAY off (and it seems okay to me while waiting for a trial run) or ...{shudder} insect time {shudder shudder}.

                                    (I know Code_Not_Shown but it shouldn't be necessary here. The calculated time coding is above and one can easily see the total below).

                                    Code:
                                    [FONT=Courier New]            Profile for C:\Only_My_Programs\Life\Life_Profile.txt[/FONT]
                                    [FONT=Courier New]            11-13-2008   Ran from 23:47:55 to 23:48:07 [B]for 12 seconds '<<<<<<<<<<[/B][/FONT]
                                    [FONT=Courier New]Alphabetical by Procedure Name        Calls       Tot ms   ms/call   % of time[/FONT]
                                    [FONT=Courier New]1)              Add_Colonies            6        3,079    513.17    11%   [/FONT]
                                    [FONT=Courier New]2)                Add_Glider            6          750    125.00     3%   [/FONT]
                                    [FONT=Courier New]3)               Center_Line           51          609     11.94     2%   [/FONT]
                                    [FONT=Courier New]4)          Default_Settings            1        7,062  7,062.00    24%   [/FONT]
                                    [FONT=Courier New]5)                 Draw_Grid           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]6)                  Font_Set            1            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]7)             Gen_Total_Set           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]8)                 Get_Inkey    3,161,555        4,299      0.00    15%   [/FONT]
                                    [FONT=Courier New]9)                    Grproc          141            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]10)                Header_Msg            2           16      8.00     0%   [/FONT]
                                    [FONT=Courier New]11)              Header_Print           40          595     14.88     2%   [/FONT]
                                    [FONT=Courier New]12)                Header_Set           29          408     14.07     1%   [/FONT]
                                    [FONT=Courier New]13)                   Makegun           35            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]14)         Mouse_Click_Check           30            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]15)            Opening_Screen            1        4,671  4,671.00    16%   [/FONT]
                                    [FONT=Courier New]16)       Pattern_Soccer_Ball           58            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]17)                    Pbmain            1            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]18)           Pixel_Color_Set           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]19)      Population_Unchanged           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]20)           Profile_Ordered            1            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]21)                Random_W_H            6            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]22)               Rules_Print            1        1,063  1,063.00     4%   [/FONT]
                                    [FONT=Courier New]23)                 Rules_Set            1            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]24)         Sayings_Data_Load            1           78     78.00     0%   [/FONT]
                                    [FONT=Courier New]25)             Sayings_Print           29        1,375     47.41     5%   [/FONT]
                                    [FONT=Courier New]26)              Spacebar_Msg            1        1,375  1,375.00     5%   [/FONT]
                                    [FONT=Courier New]27)                 Start_New            3        3,829  1,276.33    13%   [/FONT]
                                    [FONT=Courier New]28)              Stasis_Check           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]29)          Stasis_Point_Set            2            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]30)              Time_Elapsed           26            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]31)               Update_Gary            9            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]32)  Update_With_All_Pointers           10            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]33)   Update_With_No_Pointers           10            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]34)              Var_Ptrs_Set            1            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]35)         Wrap_Horizontally           29            0      0.00     0%   [/FONT]
                                    [FONT=Courier New]                         [B]Total of ArrayTime() = 29,209'<<<<<<<<<<[/B][/FONT]
                                    Last edited by Gösta H. Lovgren-2; 13 Nov 2008, 11:25 PM.
                                    It's a pretty day. I hope you enjoy it.

                                    Gösta

                                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                    Comment


                                    • #19
                                      I had being toying with the idea of using a UDT instead of multiple arrays but it looked a bit hairy until I spotted the new custom array feature in PB9's Array Sort.

                                      After a complete rewrite the code is so clean now we can eat our dinner of it. Another plus for PB9!

                                      I was just about to publish it when I saw that you had sneaked a % into the fray, Gösta. However, with a UDT at the helm adding new columns is just a few minutes work.

                                      Re your timings observation I'll have a look myself and try and see what is going on.

                                      I've changed how we read the file. Both of us were reading the whole file and then removing the lines were no calls were made by a procedure. What I'm now doing is to filter those lines so that they don't come into play at the outset.

                                      In the meantime here is the rewrite.

                                      Added:
                                      1. A multi-key feature has been included. Where there are sorted numeric items of the same value they, in turn, are sorted alphabetically by procedure name. It just makes for a tidier output.
                                      2. An unused procedure list.
                                      3. A Win32API exclusion list


                                      Code:
                                      Type ProfileMetrics
                                        Procedure As String * 50
                                        Calls As Long
                                        Time As Long
                                        TimePerCall As Single
                                        Percentage As Single
                                      End Type
                                      
                                      Function FillArray( ArrayEx() As String ) As Long
                                      Local x  As Long
                                      
                                      	ReDim ArrayEx( 1 To DataCount ) As String
                                      	
                                      	For x = 1 To DataCount
                                      		ArrayEx( x ) = Read$( x )
                                        Next
                                      
                                      	Function = DataCount
                                      	
                                      	Data "CREATEDIALOG"
                                        Data "CREATEDIALOGINDIRECT"
                                        Data "CMYK"
                                        Data "COPYMEMORY"
                                        Data "CREATEWINDOW"
                                        Data "DIALOGBOX"
                                        Data "DIALOGBOXINDIRECT"
                                        Data "FILLMEMORY"
                                        Data "FAILED"
                                        Data "GETNEXTWINDOW"
                                        Data "GETYVALUE"
                                        Data "GETHINST"
                                        Data "GETBVALUE"
                                        Data "GETGVALUE"
                                        Data "GETRVALUE"
                                        Data "GETMVALUE"
                                        Data "GETCVALUE"
                                        Data "GETKVALUE"
                                        Data "HRESULT_SEVERITY"
                                        Data "HRESULT_FACILITY"
                                        Data "HRESULT_FROM_WIN32"
                                        Data "HRESULT_CODE"
                                        Data "HRESULT_FROM_NT"
                                        Data "HRESULT_FROM_SETUPAPI"
                                        Data "IS_ERROR"
                                        Data "MAKE_SCODE"
                                        Data "MAKE_HRESULT"
                                        Data "MOVETO"
                                        Data "MAKELANGID"
                                        Data "MAKEROP4"
                                        Data "PALETTERGB"
                                        Data "PALETTEINDEX"
                                        Data "SCODE_CODE"
                                        Data "SCODE_SEVERITY"
                                        Data "SUCCEEDED"
                                        Data "SCODE_FACILITY"
                                        Data "ZEROMEMORY"
                                        Data "PBMAIN"
                                        Data "FILLARRAY"
                                        Data "PROFILE_ORDERED"
                                        Data "CALLSSORT"
                                        Data "TIMEPERCALLSORT"
                                        Data "TIMESORT"
                                      	
                                      End Function
                                      
                                      Function CallsSort(Param1 As ProfileMetrics, Param2 As ProfileMetrics) As Long
                                        If Param1.Calls < Param2.Calls Then
                                          Function = +1 : Exit Function
                                        End If
                                        If Param1.Calls > Param2.Calls Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure < Param2.Procedure Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure > Param2.Procedure Then
                                          Function = +1 : Exit Function
                                        End If
                                      End Function
                                      
                                      Function TimeSort(Param1 As ProfileMetrics, Param2 As ProfileMetrics) As Long
                                        If Param1.Time < Param2.Time Then
                                          Function = +1 : Exit Function
                                        End If
                                        If Param1.Time > Param2.Time Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure < Param2.Procedure Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure > Param2.Procedure Then
                                          Function = +1 : Exit Function
                                        End If
                                      End Function
                                      
                                      Function TimePerCallSort(Param1 As ProfileMetrics, Param2 As ProfileMetrics) As Long
                                        If Param1.TimePerCall < Param2.TimePerCall Then
                                          Function = +1 : Exit Function
                                        End If
                                        If Param1.TimePerCall > Param2.TimePerCall Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure < Param2.Procedure Then
                                          Function = -1 : Exit Function
                                        End If
                                        If Param1.Procedure > Param2.Procedure Then
                                          Function = +1 : Exit Function
                                        End If
                                      End Function
                                      
                                      Function Profile_Ordered(Profile_Start_Time As Long) As Long
                                      
                                        Local sInput, sTemp0, sTemp1, Uncalled As String
                                        Local fnum, lctr, accepted, i, lk, lj, found, lhrs, lmins, lsecs, longest As Long, tot As Double
                                        Dim Transfer( 1 To 3 ) As String
                                        Dim UnusedProc() As String
                                        Local Profile_FileName As String
                                        
                                        Local NoOfExclusions As Long
                                        ReDim Exclusions( 0 ) as string
                                        NoOfExclusions = FillArray( Exclusions() )
                                         
                                        Profile_FileName = CurDir$ & "\" & _ 'Exe.Path$ only returns 8 char Dos names so use CurDir$
                                                             Exe.Name$ & _ 'Progran running name
                                                             "_Profile.txt" 'Add a unique identifier to it
                                        
                                        Profile Profile_FileName 'create the file
                                        fnum = FreeFile
                                      
                                      retry:
                                        Try
                                          Open Profile_FileName For Input As #fnum
                                        Catch 
                                          Sleep 100
                                          GoTo retry
                                        End Try
                                        
                                        FileScan #fnum, Records To lctr ' Get the number of lines
                                        Dim ProfileData( 1 To lctr ) As ProfileMetrics  ' Create max array of UDTs
                                        
                                        For i = 1 To lctr
                                          Line Input #fnum, sInput
                                          Parse sInput, Transfer() ' Put line into a holding array
                                          lk = Val(Transfer(2))     ' ie Number of calls
                                          sTemp0 = UCase$(Transfer(1)) ' ie Procedure name
                                          Array Scan Exclusions(), = sTemp0, To found
                                          If IsFalse(found) Then
                                            sTemp0 = MCase$(Transfer(1)) ' I hate all CAPS as well <smile>
                                            If lk <> 0 Then ' accept for analysis
                                              Incr accepted
                                              ProfileData(accepted).Procedure = sTemp0 ' and now transfer data to UDTs
                                              ProfileData(accepted).Calls = lk
                                              ProfileData(accepted).Time = Val(Transfer(3)) ' ie Time spent
                                              ' Now calculate the Time per Call element
                                              ProfileData(accepted).TimePerCall = Int(ProfileData(accepted).Time*1000/ProfileData(accepted).Calls)/1000
                                            Else
                                              Uncalled = Build$(Uncalled, sTemp0, $CrLf)
                                            End If
                                          End If
                                        Next
                                        Close #fnum
                                        
                                        ReDim Preserve ProfileData( 1 To accepted ) ' Trim the array of UDTs to the lines we accepted
                                        
                                        ' Uncalled has a terminating $CrLF which will give an excessive procedure count when parsing later
                                        Uncalled = RTrim$(Uncalled, $CrLf)
                                        
                                        ' Calculate percentage times
                                        For i = 1 To accepted
                                          tot = tot + ProfileData(i).Time
                                        Next
                                        For i = 1 To accepted
                                          ProfileData(i).Percentage = Round(ProfileData(i).Time/tot, 3)*100
                                        Next
                                        
                                        ' Find the longest procedure name
                                        For i = 1 To accepted
                                          lk = Len( Trim$(ProfileData(i).Procedure) )
                                          If lk > longest Then longest = lk
                                        Next
                                        Let longest = longest + 6 ' bit of elbow room
                                      
                                        Open Profile_FileName For Output As #fnum
                                             
                                          lhrs = Profile_Start_Time \ 3600
                                          lmins = (Profile_Start_Time  - (lhrs * 3600)) \ 60
                                          lsecs = (Profile_Start_Time -  (lhrs * 3600)) - (lmins * 60)
                                       
                                          Print #fnum, "Profile for " &  Profile_FileName 
                                          Print #fnum, Date$ & "   Ran from " & _
                                                     Using$("##:##:## to ", lhrs, lmins, lsecs) & _
                                                     Time$ & _
                                                     Using$(" for #, seconds", Timer - Profile_Start_Time) 
                                          
                                          Print #fnum: Print #fnum, "Alphabetical by Procedure Name:": Print #fnum
                                          Array Sort ProfileData() ' ie Procedures
                                          GoSub PrintSort
                                          
                                          Print #fnum: Print #fnum, "In call frequency order:": Print #fnum
                                          Array Sort ProfileData(), Using CallsSort
                                          GoSub PrintSort
                                                    
                                          Print #fnum: Print #fnum, "In time used order:": Print #fnum
                                          Array Sort ProfileData(), Using TimeSort
                                          GoSub PrintSort
                                          
                                          Print #fnum: Print #fnum, "In Time per call order:": Print #fnum
                                          Array Sort ProfileData(), Using TimePerCallSort
                                          GoSub PrintSort
                                          
                                          ' Now list the uncalled procedures
                                          Print #fnum
                                          Print #fnum, "Uncalled procedures:": Print #fnum
                                          lctr = ParseCount(Uncalled, $CrLf)
                                          ReDim UnusedProc( 1 To lctr )
                                          Parse Uncalled, UnusedProc(), $CrLf
                                          Array Sort UnusedProc()
                                          longest = Len( UnusedProc(1) ) + 2 ' for comma & space
                                          Print #fnum, UnusedProc(1);
                                          For i = 2 To lctr
                                            Print #fnum, ", ";
                                            longest = longest + Len( UnusedProc(i) ) + 2
                                            If longest > 72 Then
                                              Print #1
                                              longest = Len( UnusedProc(i) ) + 2
                                            End If
                                            Print #fnum, UnusedProc(i);
                                          Next
                                       
                                        Close #fnum
                                        
                                        Exit Function
                                        
                                      PrintSort:  
                                        Print #fnum, Space$(7 + longest);"Calls      Tot ms       ms/Call        %": Print #fnum
                                        For i = 1 To accepted
                                          sTemp0 = Trim$(ProfileData(i).Procedure)
                                          If ProfileData(i).Calls = 1 Then
                                            sTemp1 = "   ---"
                                          Else
                                            sTemp1 = Using$("####.###", ProfileData(i).TimePerCall)
                                          End If
                                          Print #fnum, Using$("##",i);") ";sTemp0;Space$(longest - Len(sTemp0));Using$("########", ProfileData(i).Calls); _
                                          Space$(6);Using$("######", ProfileData(i).Time);Space$(6);sTemp1;Space$(6-2*(sTemp1="   ---"));Using$("##.#", ProfileData(i).Percentage);"%"
                                        Next
                                        Return
                                      
                                      End Function
                                      Last edited by David Roberts; 16 Nov 2008, 04:26 PM. Reason: Formatting went to pot with short procedure names.

                                      Comment


                                      • #20
                                        For now, Dave. I think I'll stick with the last version (multiple arrays). Once I get that to the point where I'm happy, then I'll look at your latest.

                                        However, that aside here's the output from a 7 hour run, A couple formatting issues (numbers larger than planned for) it looks pretty good I think.

                                        Notice that the Calculated seconds (23,727) is pretty darn close to Total of ArrayTime() = 24,091(,125). Unlike much shorter runs last night (7-12 seconds) when the difference between the two was double or more. So I guess it's not a Profile Word_That_Must_Not_Be_Uttered at all, just an anomaly of short runs. Adding microSeconds (maybe calculated using CPU cycles) to compare with whole seconds (calculated using the Timer).

                                        I should finish up with the current version in a hour or so. Got the bulk of it done, then I'll take a deeper look at your latest incantation to see if I like it better.

                                        Code:
                                                      Profile for C:\Only_My_Programs\Life\Life_Profile.txt
                                                      11-14-2008   Ran from 00:31:57 to 07:07:24 for 23,727 seconds
                                        Alphabetical by Procedure Name        Calls       Tot ms   ms/call   % of time
                                          1)              Add_Colonies          840      432,533    514.92     2%   
                                          2)                Add_Glider          840      104,873    124.85     0%   
                                          3)               Center_Line           70          876     12.51     0%   
                                          4)          Default_Settings            1       13,516  13,516.00     0%   
                                          5)                 Draw_Grid      419,401            0      0.00     0%   
                                          6)                  Font_Set            2            0      0.00     0%   
                                          7)             Gen_Total_Set      419,402          124      0.00     0%   
                                          8)                 Get_Inkey    7,448,570        9,337      0.00     0%   
                                          9)                    Grproc      420,565           45      0.00     0%   
                                         10)                Header_Msg            3           46     15.33     0%   
                                         11)              Header_Print      420,665    6,578,171     15.64    27%   
                                         12)                Header_Set      419,402    6,552,606     15.62    27%   
                                         13)                   Makegun      420,241           16      0.00     0%   
                                         14)         Mouse_Click_Check      419,402            0      0.00     0%   
                                         15)            Opening_Screen            2       10,624  5,312.00     0%   
                                         16)       Pattern_Soccer_Ball      838,802            0      0.00     0%   
                                         17)                    Pbmain            1            0      0.00     0%   
                                         18)           Pixel_Color_Set      419,402            0      0.00     0%   
                                         19)      Population_Unchanged      419,402            0      0.00     0%   
                                         20)           Profile_Ordered            1            0      0.00     0%   
                                         21)                Random_W_H          840            0      0.00     0%   
                                         22)       Reset_Sum_Ctr_Array        1,216            0      0.00     0%   
                                         23)               Rules_Print            1        1,484  1,484.00     0%   
                                         24)                 Rules_Set            1            0      0.00     0%   
                                         25)         Sayings_Data_Load            1           93     93.00     0%   
                                         26)             Sayings_Print      419,401      322,287      0.77     1%   
                                         27)              Spacebar_Msg            1        3,641  3,641.00     0%   
                                         28)                 Start_New          420      537,406  1,279.54     2%   
                                         29)         Stasis_Accumulate           70            0      0.00     0%   
                                         30)              Stasis_Check      419,402            0      0.00     0%   
                                         31)          Stasis_Point_Set           72            0      0.00     0%   
                                         32)              Time_Elapsed      419,052            0      0.00     0%   
                                         33)               Update_Gary      139,999    2,187,531     15.63     9%   
                                         34)  Update_With_All_Pointers      139,402    4,531,219     32.50    19%   
                                         35)   Update_With_No_Pointers      140,000    2,803,870     20.03    12%   
                                         36)              Var_Ptrs_Set            1            0      0.00     0%   
                                         37)         Wrap_Horizontally      419,401          827      0.00     0%   
                                                                   Total of ArrayTime() = 24,091,125
                                        Last edited by Gösta H. Lovgren-2; 14 Nov 2008, 06:37 AM.
                                        It's a pretty day. I hope you enjoy it.

                                        Gösta

                                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                        Comment

                                        Working...
                                        X