Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Complicated SQL - can we make it?
Message
General information
Forum:
Visual FoxPro
Category:
Databases,Tables, Views, Indexing and SQL syntax
Miscellaneous
Thread ID:
00437328
Message ID:
00440529
Views:
22
Hi Ko,

This is another version of this program. It works much faster (~1min for the whole county).
********************************************************************
*  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/10/2000 05:12:54 PM
****************************************************************************************
lparameters pcConfigName, pcConfigFile, inFile_arg, outFile_arg, pcLevel, plRecalculate
* 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 empty(pcLevel) or vartype(pcLevel)<>'C'
     pcLevel='County' && State or County or Town level (County level by default)
else
     pcLevel=proper(pcLevel) && State
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,  lnIndexLines, i, lcIndexCmd
     lnIndexLines=alines(laIndexLines, alltrim(IndexOn)) && Number of lines in IndexOn field
     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
     for i=1 to lnIndexLines
          lcIndexCmd=laIndexLines[i]
          &lcIndexCmd && Create indexes
     next
     local lcOutTble
     lcOutTble=juststem(outFile_arg)
     if used(lcOutTble)
          use in (lcOutTble)
     endif
endif
=CloseView('WorkConfig') && Finish with current configuration - output table is created, if needed
**************************************************************************************************
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
** First select * Determine min and max date (could be parameters)
select min(date(val(cYear),val(cMnth),1)) as dMin, ;
     max(date(val(cYear),val(cMnth),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 ************************
********* 1 SQL ********************************************
select ccode, town,  cYear, Qtr, cMnth as Period, UseGrp, ;
     count(price) as NumSales, sum(price) as VolSales ;
     from InputTable ;
     group by 1, 2, 3, 5, 6 ;
     into cursor curMnResult
********* 2 SQL ***************************************************
select ccode, town,  cYear, Qtr as Period,  UseGrp, ;
     sum(NumSales) as NumSales, sum(VolSales) as VolSales ;
     from curMnResult ;
     group by 1, 2, 3, 4, 5 ;
     into cursor curQtrResult
******** 3 SQL ****************************************************
******* Now prepare Year to date cursor ***************************
select ccode, town, cYear, cMn as Period,  UseGrp, cYr+cMn as tmpOrder, ;
     inlist(cMn,'03','06','09','12') as lQtr, cQtr as Qtr, ;
     count(price) as YtdNumSale, sum(price) as YtdVolSale ;
     from InputTable, tblMonths ;
     where cYear=cYr and cMnth between '01' and cMn ;
     group by 1, 2, 5, 6 ;
     into cursor curYtdMnResult && Month selections
use in tblMonths && No longer needed
******** 4 SQL ************************************************************
select ccode, town, cYear, Qtr as Period, UseGrp, YtdNumSale, YtdVolSale ;
     from curYtdMnResult ;
     where lQtr=.t. ;
     into cursor curYtdQtrResult && Quater selections
********** Finished 4 temporary SQLs     *****************************************************

local lnTally, i
for i=1 to 18
     local ('lnTally'+transform(i)) && Declare lnTally1-18 as local variables
next

******** Statrt creating 18 final result cursors ********************************
** Now prepare the final result1 (group by ccode, town, usegrp) && Month  selections
select crYtd.ccode, crYtd.town, crYtd.cYear, crYtd.Period, crYtd.UseGrp, ;
     nvl(NumSales,0) as NumSales, nvl(VolSales,0) as VolSales, ;
     YtdNumSale, YtdVolSale, ;
     0000000000 as MedSale,  0000000000 as YtdMedSale ;
     from curYtdMnResult crYtd left join curMnResult cr ;
     on   crYtd.ccode+crYtd.town+crYtd.cYear+crYtd.Period+crYtd.UseGrp =  ;
     cr.ccode+cr.town+cr.cYear+cr.Period+cr.UseGrp  ;
     into cursor curFinalResult1 && Lowest level
lnTally1=_tally
** Now prepare the final result2 (group by ccode, town, usegrp) && Quater  selections
select crYtd.ccode, crYtd.town, crYtd.cYear, crYtd.Period, crYtd.UseGrp, ;
     nvl(NumSales,0) as NumSales, nvl(VolSales,0) as VolSales, ;
     YtdNumSale, YtdVolSale, ;
     0000000000 as MedSale,  0000000000 as YtdMedSale ;
     from curYtdQtrResult crYtd left join curQtrResult cr ;
     on   crYtd.ccode+crYtd.town+crYtd.cYear+crYtd.Period+crYtd.UseGrp =  ;
     cr.ccode+cr.town+cr.cYear+cr.Period+cr.UseGrp  ;
     into cursor curFinalResult2 && Lowest level - Quater
lnTally2=_tally
** Now prepare the final result3 (group by ccode, town, usegrp) && Year  selections
select ccode, town,  cYear, 'YR' as Period, UseGrp, ;
     sum(NumSales) as NumSales, sum(VolSales) as VolSales, ;
     sum(NumSales) as YtdNumSale, sum(VolSales) as YtdVolSale, ;
     0000000000 as MedSale,  0000000000 as YtdMedSale ;
     from curQtrResult ;
     group by 1, 2, 3, 5 ;
     into cursor curFinalResult3 && Year selections
lnTally3=_tally
* Close temporary cursors and no needed tables
use in curMnResult
use in curYtdMnResult
use in curQtrResult
use in curYtdQtrResult

*****************************************************************
for i=4 to 6
** Now group by ccode, town && All UseGrp
     select ccode, town, cYear, Period, 'ZZZ' as UseGrp, ;
          sum(NumSales) as NumSales, sum(VolSales+000000000000) as VolSales, ;
          sum(YtdNumSale) as YtdNumSale, sum(YtdVolSale+000000000000) as YtdVolSale, ;
          MedSale, YtdMedSale ;
          from ('curFinalResult'+transform(i-3)) ;
          group by 1 , 2, 3, 4 ;
          into cursor ('curFinalResult'+transform(i)) && ccode, town, all UseGrp
     store _tally to ('lnTally'+transform(i))
next
if pcLevel<>'Town' && Don't need them for Town level
     for i=7 to 9
** Now group by ccode, UseGrp && All Towns
          select ccode, 'ZZZZ' as town, cYear, Period, UseGrp, ;
               sum(NumSales) as NumSales, sum(VolSales+000000000000) as VolSales, ;
               sum(YtdNumSale) as YtdNumSale, sum(YtdVolSale+000000000000) as YtdVolSale, ;
               MedSale, YtdMedSale ;
               from ('curFinalResult'+transform(i-6)) ;
               group by 1,3,4,5 ;
               into cursor ('curFinalResult'+transform(i)) && ccode, UseGrp, all towns
          store _tally to ('lnTally'+transform(i))
     next

     for i=10 to 12
** Now group by ccode && All Towns and all UseGrp
          select ccode, town, cYear, Period, 'ZZZ' as UseGrp, ;
               sum(NumSales) as NumSales, sum(VolSales+000000000000) as VolSales, ;
               sum(YtdNumSale) as YtdNumSale, sum(YtdVolSale+000000000000) as YtdVolSale, ;
               MedSale, YtdMedSale ;
               from ('curFinalResult'+transform(i-3)) ;
               group by 1, 3, 4 ;
               into cursor ('curFinalResult'+transform(i)) && ccode, All towns, All UseGrp
          store _tally to ('lnTally'+transform(i))
     next
endif
if pcLevel='State' && Don't need them for county level
** Now  All Towns, counties - state level - specific UseGrp
     for i=13 to 15
          select 'ZZ' as ccode, town, cYear, Period, UseGrp, ;
               sum(NumSales) as NumSales, sum(VolSales+000000000000) as VolSales, ;
               sum(YtdNumSale) as YtdNumSale, sum(YtdVolSale+000000000000) as YtdVolSale, ;
               MedSale, YtdMedSale ;
               from ('curFinalResult'+transform(i-6)) ;
               group by 3, 4, 5 ;
               into cursor ('curFinalResult'+transform(i)) && All ccode, All towns, specific UseGrp
          store _tally to ('lnTally'+transform(i))
     next

** Now summary - state level
     for i=16 to 18
          select 'ZZ' as ccode, town, cYear, Period, 'ZZZ' as UseGrp, ;
               sum(NumSales) as NumSales, sum(VolSales+000000000000) as VolSales, ;
               sum(YtdNumSale) as YtdNumSale, sum(YtdVolSale+000000000000) as YtdVolSale, ;
               MedSale, YtdMedSale ;
               from ('curFinalResult'+transform(i-3)) ;
               group by 3, 4 ;
               into cursor ('curFinalResult'+transform(i)) && All ccode, All towns, All UseGrp
          store _tally to ('lnTally'+transform(i))
     next
endif

********** We prepared 18 Final results (each type of groupings)
********************************

if  lcOldSetTalk='OFF'
     set talk off && Restore set talk settings
endif
********************
if used('OutTable')
     use in OutTable
endif

local i, lcOldExact
lcOldExact=set('exact') && Save current exact settings
set exact off && To perform partial string comparision

use (outFile_arg) in 0 alias OutTable  && No error checking for now
local lcSearchExpr, lnStart, lnEnd
do case
case pcLevel='Town' && Town level - don't need county & state
     lnStart=1
     lnEnd=6
case pcLevel='County' && County level - don't need state
     lnStart=1
     lnEnd=12
case pcLevel='State'
     lnEnd=18
     if plRecalculate && Re-calculate again
          lnStart=1
     else
          lnStart=13
     endif
endcase

local PrevOnEsc, PrevEscape, lnCount, ;
     halt, lnUpdateNumber, msgTail, loTherm, lnCount, mnEnd, loTemp

* 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

for i=lnStart to lnEnd && Processed all curFinalResults
     store 0 to lnCount
     lnTally=evaluate('lnTally'+transform(i))
     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 InputTable
     set order to (tag(i))
     select ('curFinalResult'+transform(i)) && 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

          scatter name loTemp

******** First let's deal with Median ***********************
          do case
          case loTemp.NumSales=0
               loTemp.MedSale=0
          case loTemp.NumSales=1
               loTemp.MedSale=loTemp.VolSales
          case loTemp.NumSales=2
               loTemp.MedSale=round(loTemp.VolSales/2,0)
          otherwise && Number of Sales > 2
               lcSearchExpr=iif(loTemp.ccode='ZZ','',loTemp.ccode)+ ;
                    iif(loTemp.town='ZZZZ','',loTemp.town) + ;
                    iif(loTemp.UseGrp='ZZZ','',loTemp.UseGrp)+ ;
                    loTemp.cYear+ ;
                    iif(loTemp.Period='YR','',loTemp.Period)
               loTemp.MedSale=GetMedian('InputTable','price',loTemp.NumSales,lcSearchExpr)
          endcase
** Let's now deal with YTD Median
          do case
          case loTemp.NumSales=loTemp.YtdNumSale
               loTemp.YtdMedSale=loTemp.MedSale && MedSale and YTDMedSale are equal
          case loTemp.YtdNumSale=1
               loTemp.YtdMedSale=loTemp.YtdVolSale
          case loTemp.YtdNumSale=2
               loTemp.YtdMedSale=round(loTemp.YtdVolSale/2,0)
          otherwise && greater than 2 and <> NumSales
               lcSearchExpr=iif(loTemp.ccode='ZZ','',loTemp.ccode)+ ;
                    iif(loTemp.town='ZZZZ','',loTemp.town) + ;
                    iif(loTemp.UseGrp='ZZZ','',loTemp.UseGrp)+ ;
                    loTemp.cYear
               loTemp.YtdMedSale=GetMedian('InputTable','price',loTemp.YtdNumSale,lcSearchExpr)
          endcase
          lcSearchExpr=loTemp.ccode+loTemp.town+loTemp.cYear+loTemp.Period+loTemp.UseGrp
***********************************************************
          select OutTable
          if tagno('Geo')>0 and seek(lcSearchExpr,'OutTable','Geo')
** Now we are on the right record
          else && Either tag doesn't exist or it's a new record and should be inserted
               append blank
          endif
          gather name loTemp
          select ('curFinalResult'+transform(i)) && Return back
     endscan
     use in ('curFinalResult'+transform(i)) && This result is already processed, close it
     wait clear
     release loTherm
next
** Restore previous settings
on escape &PrevOnEsc
set escape &PrevEscape
set message to
* Close everything, which is not longer needed

use in InputTable
use in OutTable
for i=1 to 18
     if used('curFinalResult'+transform(i))
          use in ('curFinalResult'+transform(i))
     endif
next
** 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
return
>Nadya,
>
>Looks fine, but you forgat to update the time stamp <g>
>
>
>
>Greetings,
>
>Ko ;-)
>

>>Ko,
>>
>>I added unions and it works like a charm. I was incorrect in my assumption on maximum number of unions. The 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/01/2000 04:16:06 PM
>>********************************************************************
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform