Hi Ko,

Actually, it seems, like I choose unefficient way of calculating statistics. For 50000 records this program works too slow. I may re-write it from scratch again. Currently I made few improvements in this code, but I don't expect to gain much. The 'improved' code is bellow:

********************************************************************
*  Description.......: RunConfig - runs saved configuration
*  Calling Samples...: RunConfig('StdTrxnSale','vAllConfigs','\redp\work\query\qry000001.dbf','mastats.dbf'
*  Parameter List....: pcConfigName, pcConfigFile, infile_arg, outfile_arg
*  Created by........: Nadya Nosonovsky 11/01/2000 03:27:58 PM
*  Modified by.......: Nadya Nosonovsky 11/08/00 08:10:58 PM
**************************************************************************
lparameters pcConfigName, pcConfigFile, inFile_arg, outFile_arg
* Validate passed parameters first
if empty(pcConfigName) or vartype(pcConfigName)<>'C'
     pcConfigName=upper('stdTrxnSale') && Default configuration
else
     pcConfigName=upper(pcConfigName)
endif
if empty(pcConfigFile) or vartype(pcConfigFile)<>'C'
     pcConfigFile='vAllConfigs' && Name of the view
endif

if vartype(inFile_arg)='C' and not file(forceext(inFile_arg,'DBF'))
     inFile_arg=getfile('DBF', '', '', 0, 'Select Input Table')
     if empty(inFile_arg)  && user escaped or cancelled without picking
          return .f.           && fail quietly
     endif
endif
if vartype(inFile_arg)='C' and not file(forceext(outFile_arg,'DBF'))
     outFile_arg=getfile('DBF', '', '', 0, 'Select or Create Output Table')
     if empty(outFile_arg)  && user escaped or cancelled without picking
          return .f.           && fail quietly
     endif
endif
local lnOldSelect
lnOldSelect=select() && Save current area
if not dbused('Stats') && Stats database in not opened yet
     open database Stats
endif
set database to Stats
if used('WorkConfig')
     use in WorkConfig
endif
use (pcConfigFile) in 0 alias WorkConfig nodata && Open the view with configuration
select WorkConfig
lcConfigName=pcConfigName
requery()
if empty(inFile_arg) or vartype(inFile_arg)<>'C'
     if not empty(WorkConfig.InputTble) && use this file as InputTble
          inFile_arg=alltrim(WorkConfig.InputTble)
     else
          inFile_arg=getfile('DBF', '', '', 0, 'Select Input Table')
          if empty(inFile_arg)  && user escaped or cancelled without picking
               return .f.           && fail quietly
          endif
     endif
endif
if empty(outFile_arg) or vartype(outFile_arg)<>'C'
     if not empty(WorkConfig.OutTble) && use this file as InputTble
          outFile_arg=alltrim(WorkConfig.OutTble)
     else
          outFile_arg=getfile('DBF', '', '', 0, 'Select or create Output Table')
          if empty(outFile_arg)  && user escaped or cancelled without picking
               return .f.           && fail quietly
          endif
     endif
endif
if not file(forceext(inFile_arg,'DBF'))
     =messagebox (inFile_arg + ' does not exist! ',48, 'Error')
     return .f.  && fail
endif
if WorkConfig.UpdExist && Update existing table
     if not file(forceext(outFile_arg,'DBF'))
          =messagebox ('File to update: '+outFile_arg + ' does not exist! ',48, 'Error')
          return .f.  && fail
     endif
else
     select WorkConfig
     local lcCreateTableCommand
     lcCreateTableCommand='create table '+outFile_arg+ ' free ('
     scan
          lcCreateTableCommand=lcCreateTableCommand+;
               iif(!empty(FieldName),FieldName,F_NewName)+ ;
               space(1)+FieldType+ iif(not empty(FieldLen),'('+transform(FieldLen)+ ;
               iif(not empty(FieldDec),','+transform(FieldDec),'')+')','') + ','
     endscan
     lcCreateTableCommand=left(lcCreateTableCommand,len(lcCreateTableCommand)-1)+')'
     &lcCreateTableCommand && Create free table with the specified structure
     index on ccode+town+cYear+Period+UseGrp tag Geo
     local lcOutTble

     lcOutTble=juststem(outFile_arg)
     if used(lcOutTble)
          use in (lcOutTble)
     endif
endif
local lnSeconds, lnMinutes, lnStartTime

* note clock reading for generating final timing statistics
lnStartTime = seconds()                         && # seconds since midnight

* Now let's deal with the specific configuration
* More general code will come later
if used('InputTable')
     use in InputTable
endif
use (inFile_arg) in 0 alias InputTable  && No error checking for now
*******************************************************
wait window nowait 'Wait while counting statistics...'
* First of all, prepare cursors of all possible periods
* The code bellow is created by Ed Rauh
local dIncDate, aDateRange[1,2], cDateToStick, cMonthPart
select min(date(val(cYear),val(cmonth),1)) as dmin, ;
     max(date(val(cYear),val(cmonth),1)) as dMax ;
     from InputTable ;
     into array aDateRange  && Save min and max 1st of month in array
select 0
create cursor tblMonths (cYr C(4), ; && Different from Input table structure to make SQLs easier
cMn C(2), cQtr C(2) )

dIncDate = aDateRange[1,1]              && Start at first month
do while dIncDate <= aDateRange[1,2]    && For each month through the last
     cDateToStick = dtos(dIncDate)        && Convert to YYYYMMDD
     cMonthPart = substr(cDateToStick,5,2) && Snag MM
     insert into tblMonths values (left(cDateToStick,4), ;
          cMonthPart, 'Q' + transform(ceiling(val(cMonthPart)/3)))
     dIncDate = gomonth(dIncDate,1)       && next month
enddo
** End of Ed Rauh's code - cursor tblMonths is created **********
local lcOldSetTalk
lcOldSetTalk=set('talk')
set talk window
set talk on && To visualize thermometr
* Start of Ko Wisse code *****************************************
select distinct cYr, cQtr from tblMonths into cursor tblQtrs

select ccode, town,  cYear, Qtr as Period, UseGrp, ; && Quater
count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 1, 2, 3, 4, 5 ;
     union ;  && Now month
select ccode, town,  cYear, cmonth as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 1, 2, 3, 4, 5 ;
     union; && Now the same for county level
select ccode, 'ZZZZ',  cYear, Qtr as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 1, 3, 4, 5 ;
     union ;  && Now month
select ccode, 'ZZZZ',  cYear, cmonth as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 1, 3, 4, 5 ;
     union ;   && Now quater
select 'ZZ', 'ZZZZ',  cYear, Qtr as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by  3, 4, 5 ;
     union ;  && Now month
select 'ZZ', 'ZZZZ',  cYear, cmonth as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 3, 4, 5 ;
     into cursor curResult

******* Now prepare Year to date cursor ***************************
select ccode, town, cYear, 'YR' as Period, UseGrp, cYearr+'YR' as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable ;  && Years first
group by 1, 2, 5, 6 ;
     union ;  && Now quaters
select ccode, town, cYr, cQtr as Period, UseGrp, cYr+cQtr as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblQtrs ;
     where cYear=cYr and Qtr between 'Q1' and cQtr ;
     group by 1, 2, 5, 6 ;
     union ; && Now months
select ccode, town, cYr, cMn as Period, UseGrp, cYr+cMn as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblMonths ;
     where cYear=cYr and cmonth between '01' and cMn ;
     group by 1, 2, 5, 6 ;
     union ; && Continue with county level
select ccode, 'ZZZZ', cYr, 'YR' as Period, UseGrp, cYr+'YR' as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblYears ;
     where cYear=cYr ;  && Years first
group by 1, 5, 6 ;
     union ;  && Now quaters
select ccode, 'ZZZZ', cYr, cQtr as Period, UseGrp, cYr+cQtr as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblQtrs ;
     where cYear=cYr and Qtr between 'Q1' and cQtr ;
     group by 1, 5, 6 ;
     union ; && Now months
select ccode, 'ZZZZ', cYr, cMn as Period, UseGrp, cYr+cMn as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblMonths ;
     where cYear=cYr and cmonth between '01' and cMn ;
     group by 1, 5, 6 ;
     union ; && Continue with state level
select 'ZZ', 'ZZZZ', cYear, 'YR' as Period, UseGrp, cYear+'YR' as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable ;  && Years first
group by 5, 6 ;
     union ;  && Now quaters
select 'ZZ', 'ZZZZ', cYr, cQtr as Period, UseGrp, cYr+cQtr as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblQtrs ;
     where cYear=cYr and Qtr between 'Q1' and cQtr ;
     group by  5, 6 ;
     union ; && Now months
select 'ZZ', 'ZZZZ', cYr, cMn as Period, UseGrp, cYr+cMn as tmpOrder, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblMonths ;
     where cYear=cYr and cmonth between '01' and cMn ;
     group by 5, 6 ;
     into cursor curYtdResult

** Now prepare the final result
select crYtd.ccode, crYtd.town, cYr, crYtd.Period, crYtd.UseGrp, ;
     NumSales, VolSales, YtdNumSale, YtdVolSale ;
     from curYtdResult crYtd left join curResult cr ;
     on   crYtd.ccode+crYtd.town+crYtd.cYr+crYtd.Period+crYtd.UseGrp =  ;
     cr.ccode+cr.town+cr.cYear+cr.Period+cr.UseGrp  ;
     into cursor curFinalResult
local lnTally
lnTally=_tally
if  lcOldSetTalk='OFF'
     set talk off
endif
* Close temporary cursors and no needed tables
use in curYtdResult
use in curResult
use in tblMonths
use in tblQtrs
********************
if used('OutTable')
     use in OutTable
endif
use (outFile_arg) in 0 alias OutTable  && No error checking for now

local lcSearchExpr, lcCCode, lcTown, lccYear, lcPeriod, lcUseGrp, ;
     lnNumSales, lnVolSales, lnYtdNumSale, lnYtdVolSale, ;
     lnMedian, lnYtdMedian, lcWhere, lcWhereYTD
local PrevOnEsc, PrevEscape, lnCount, ;
     halt, lnUpdateNumber, msgTail, loTherm, lnCount, mnEnd

* support user Escapes for interrupting the main loop
PrevOnEsc = on('escape')                    && save previous Escape handler
PrevEscape = set('escape')                    && previous Escape enablement state
set escape on                                   && enable escape handling
halt = .f.                                        && allow loop to run until this flag is toggled
on escape halt = .t.                         && force immediate termination if user escapes
store 0 to lnCount

set message to 'Calculating statistics for '+transform(lnTally)+' records'
do case
case lnTally<100 && Very rare case
     lnUpdateNumber=1
case between(lnTally,100,10000)
     lnUpdateNumber=100
case lnTally>10000
     lnUpdateNumber=val('1'+replicate('0',len(transform(lnTally))-3))
endcase
* assemble fixed portion of status bar message outside of loop, for speed
msgTail = "/" + transform(lnTally) + ".  Wait or press Esc to cancel ..."

*--- instantiate thermometer bar class....
loTherm = newobject("thermometer", "wg.vcx","","Calculation Progress for: "+dbf('OutTable'),lnTally)
loTherm.show()
select curFinalResult && Scan loop in Final result
scan
     lnCount=lnCount+1

* check for user Escape
     if m.halt                                   && user escaped
          exit                                   && fall out of loop
     endif

** Update status message
     if mod(lnCount,100) = 0
          set message to 'Record # '+transform(lnCount)+m.msgTail
     endif

** Update thermometr
     if mod(lnCount,lnUpdateNumber) = 0
          loTherm.update(lnCount)
     endif

     lcCCode=ccode
     lcTown=town
     lccYear=cYr
     lcPeriod=Period
     lcUseGrp=UseGrp
     lnNumSales=iif(isnull(NumSales),0,NumSales)
     lnVolSales=iif(isnull(VolSales),0,VolSales)
     lnYtdNumSale=iif(isnull(YtdNumSale),0,YtdNumSale)
     lnYtdVolSale=iif(isnull(YtdVolSale),0,YtdVolSale)
     lcSearchExpr=upper(lcCCode+lcTown+lccYear+lcPeriod+lcUseGrp)

     if lnNumSales<3
          do case
          case lnNumSales=0
               lnMedian=0
          case lnNumSales=1
               lnMedian=lnVolSales
          case lnNumSales=2
               lnMedian=round(lnVolSales/2,0)
          endcase
     else && lnNumSales>=3
          lcWhere=''
          if lcCCode<>'ZZ'
               lcWhere=lcWhere+'ccode="'+ lcCCode+'" and '
          endif
          if lcTown<>'ZZZZ'
               lcWhere=lcWhere+'town="'+lcTown + '" and '
          endif
          lcWhere=lcWhere+ 'cYear="'+lccYear+'" and UseGrp="'+lcUseGrp+'"'
          lcWhereYTD=lcWhere
          do case
          case left(lcPeriod,1)='Q' && Quater
               lcWhere=lcWhere+' and Qtr="'+lcPeriod+'"'
               lnMedian=GetMedianValue('InputTable','Price',lcWhere)
               if lnNumSales=lnYtdNumSale && Same number of sales
                    lnYtdMedian=lnMedian
               else
                    lcWhereYTD=lcWhereYTD+' and Qtr between "Q1" and "'+lcPeriod+'"'
                    lnYtdMedian=GetMedianValue('InputTable','Price',lcWhereYTD)
               endif
          case left(lcPeriod,1)='Y' && Year
               lnMedian=GetMedianValue('InputTable','Price',lcWhere)
               lnYtdMedian=lnMedian
          otherwise && Month
               lcWhere=lcWhere+' and cMonth="'+lcPeriod+'"'
               if lnNumSales=lnYtdNumSale && Same number of sales
                    lnYtdMedian=lnMedian
               else
                    lcWhereYTD=lcWhereYTD+' and cMonth between "01" and "'+lcPeriod+'"'
                    lnYtdMedian=GetMedianValue('InputTable','Price',lcWhereYTD)
               endif
          endcase
     endif

     if tagno('Geo')>0 and seek(lcSearchExpr,'OutTable','Geo')
          replace OutTable.NumSales with lnNumSales, ;
               OutTable.VolSales with lnVolSales, ;
               OutTable.YtdNumSale with lnYtdNumSale, ;
               OutTable.YtdVolSale with lnYtdVolSale, ;
               OutTable.MedSale with lnMedian, ;
               OutTable.YtdMedSale with lnYtdMedian in OutTable
     else && Either tag doesn't exist or it's a new record and should be inserted
          insert into OutTable values (lcCCode, lcTown, lccYear, lcPeriod, lcUseGrp, ;
               lnNumSales, lnYtdNumSale, lnVolSales, lnYtdVolSale, ;
               lnMedian, lnYtdMedian)
     endif
endscan
wait clear
release loTherm
** Restore previous settings
on escape &PrevOnEsc
set escape &PrevEscape
set message to
* Close everything, which is not longer needed
use in curFinalResult
use in InputTable
use in OutTable
use in WorkConfig
** Determine elapsed time
mnEnd = seconds()

lnSeconds=mnEnd - lnStartTime
lnMinutes=int(lnSeconds/60)
lnSeconds=round(lnSeconds-lnMinutes*60,0)
wait "Elapsed time for calculating statistics is " + ;
     iif(lnMinutes>0, transform(lnMinutes)+" min. ","")+;
     transform(lnSeconds) + " sec." window nowait

>Nadya,
>
>Looks fine, but you forgat to update the time stamp <g>
>
>
>
>Greetings,
>
>Ko ;-)
>

---

If it's not broken, fix it until it is.


My Blog