[fpc-pascal] sorting and merging array of records

waldo kitty wkitty42 at windstream.net
Wed Jan 11 23:46:53 CET 2012


On 1/11/2012 11:11, Sven Barth wrote:
> Am 11.01.2012 09:27, schrieb waldo kitty:
>> i tried this but could only get so far and then not further so i backed
>> up and punted the ball... now i'm trying this with a sortedcollection
>> and while i can apparently insert items, i haven't figured out how to
>> access them and print their contents... unless their contents are
>> garbage like the following prints out...
>
> You know that you're handling with pointer here as well? ;)

yes...

> I never used TP's T(Sorted)Collection, so the following are mostly guesses, but
> I'll try.

thanks... i finally got something working before reading your message... i ended 
up digging out my old Tom Swan "Mastering Turbo Pascal 6" book... there was a 
clear example that i was able to follow with a few tweaks for my data 
structure... it was easier to flip the pages back and forth while looking than 
to keep trying to jump between different windows on the screen... gimme a nice 
paperback book like this one any day! ;)

in any case, i'm needing a touch more assistance if you or anyone else are 
willing to give it... code at the end... questions coming up now...

1. right now the compare is working on the catalog number (TTLERec.catnbr) and 
with duplicates:=FALSE there are no duplicates... however, i need to be able to 
choose which record to keep when there is a duplicate catnbr but the epoch 
(TTLERec.epoch) is different... right now it is throwing out all but the 
first... how can i tell it how to decide which one to throw away? i saw earlier 
that one of the parent objects has neat functions like AtPut which would easily 
allow me to overwrite an existing record that's too old... i just don't know if 
i can use that in the middle of an insert or a search or just exactly where i 
would even put code to do this...

2. something else i'm running into is with duplicates:=FALSE, there's a whole 
bucket load of records that are not disposed of when i wipe out the 
collection... heaptrc hollers right nasty to me about'em on exit... i can only 
assume that these are the duplicates but i don't understand why they are still 
hanging around if insert or add threw them away already :/

[TRIM]
>> data^.catnbr := Copy(data^.satdata[1],3,5);
>> data^.epoch := Real_Value(data^.satdata[1],19,14);
>> inc(sat_cnt);
>> aTLECollection^.insert(data);
>> dispose(data);
>
> Don't do this! You'll free the memory you allocated for your record. The
> collection will only contain a pointer to this data! (Many of the rules I
> mentioned for T(FP)List apply here as well)

uh? for some reason i thought that the insert was copying the data to a place 
and then setting the pointer to there for the collection... i tried with and 
without the dispose(data) but it still looked the same... of course i was tired 
and might not have been looking at the right writeln debug output...

>> writeln(PTLERec(aTLECollection)^.catnbr);
>> writeln(PTLERec(aTLECollection)^.epoch);
>> {$ENDIF}
>
> Ehm... you know that it can't work if you cast a TTLECollection pointer to a
> TTLERec pointer? These are two different structures. No wonder why you only see
> garbage as you most likely see the contents of the Collection (which consists
> mostly of pointers).

i told ya i get confused with pointers at times :lol: i know it is a pointer but 
what's under it and how to get to it? :laugh: and with no easily found clear 
examples like i was able to find in my book, well... i should mention that it 
was also like very early in the morning and i hadn't slept yet ;)

like i wrote above, i have it working now... i just need to get the duplicates 
elimination to keep the right one... this thing is fast, too! one goal 
accomplished :P

> See at the top of the mail how you'd access the contents
> correctly. Normally I'd suggest you to simply guery the "Count - 1"th item, but
> in this exact case you'd need to search the item again as you're using a sorting
> list and the last inserted item might not be at the last position of the list
> (as Insert maintains the order of the list).

yeah, that was a debug attempt to read what was just put in... i resorted to 
filling the collection and then doing a foreach on them in a later step... now i 
have some output files that i can compare and see what's happening...

i've saved all the posts in this thread for reference... i know there's some 
good tidbits in them...  once i get more used to my code, i might actually see 
more of what you were showing me :)


so... here's my current batch of code... it ain't pretty, its my brother ;)


program satsort;

uses {$IFDEF DEBUG}heaptrc,{$ENDIF}strings,objects,math,crt,dos;

type
   Tvector    = array [1..4] of double;
   Tcat_nbr   = pstring;
   Tsat_name  = pstring;
   Tline_data = pstring;
   PTLERec    = ^TTLERec;
   TTLERec    = object(TObject)
                  satname  : Tsat_name;
                  satdata1 : Tline_data;
                  satdata2 : Tline_data;
                  catnbr   : Tcat_nbr;
                  epoch    : double;
                  constructor Init(sname,sdata1,sdata2,cnbr:string; edate:double);
                  destructor Done; virtual;
                end;
   PTLEColl   = ^TTLEColl;
   TTLEColl   = object(TSortedCollection)
                  function Compare(Key1,Key2:Pointer):sw_integer; virtual;
                  function KeyOf(Item:Pointer):Pointer; virtual;
                end;


// TTLERec
constructor TTLERec.Init(sname,sdata1,sdata2,cnbr:string; edate:double);
begin
   satname  := NewStr(sname);
   satdata1 := NewStr(sdata1);
   satdata2 := NewStr(sdata2);
   catnbr   := NewStr(cnbr);
   epoch    := edate;
end;

destructor TTLERec.Done;
begin
   dispose(satname);
   dispose(satdata1);
   dispose(satdata2);
   dispose(catnbr);
end;


// TTLEColl
function TTLEColl.Compare(key1,key2:pointer):sw_integer;
begin
   compare := strcomp(key1,key2);
end;


function TTLEColl.KeyOf(Item:Pointer):Pointer;
begin
   KeyOf := PTLERec(Item)^.catnbr;
end;



const
   data_type : byte = 3;


var
   TLENewName,
   data_drive,data_dir,
   work_drive,work_dir  : string;
   UTC_offset           : double;
   DST,allowdupes       : boolean;
   fsat,fobs            : text;
   obs_name             : string[25];
   piss                 : Tvector;
   gigo                 : char;
   my_sats              : longint;
   aTLERec              : PTLERec;
   aTLEColl             : PTLEColl;

[...]

Procedure ShowOneRec(p: PTLERec; var oFile: text);
begin
   writeln(oFile,p^.satname^);
   writeln(oFile,p^.satdata1^);
   writeln(oFile,p^.satdata2^);
//  writeln(oFile,p^.catnbr^);
//  writeln(oFile,p^.epoch);
end;


Procedure PrintRecords(db: PCollection; oFN : string);
var
   outFile : text;

   Procedure PrintOneRec(p: PTLERec); far;
   begin
     ShowOneRec(p, outFile);
   end;

begin
   assign(outFile,oFN);
   rewrite(outFile);
   db^.ForEach(@PrintOneRec);
   close(outFile)
end;


Function Input_Satellite_List(FN: string) : longint;
var
   MySatName  : string;
   MySatData1 : string;
   MySatData2 : string;
   MyCatNbr   : string;
   MyEpoch    : double;
   sat_cnt    : longint;

begin
   sat_cnt := 0;
   Assign(fsat,fn);
   Reset(fsat);
   writeln('file '+fn+' opened...');
   while not EOF(fsat) do
     begin
       Readln(fsat,MySatName);
       Readln(fsat,MySatData1);
       Readln(fsat,MySatData2);
       MyCatNbr := Copy(MySatData1,3,5);
       MyEpoch  := Real_Value(MySatData1,19,14);
       inc(sat_cnt);
       aTLEColl^.insert(New(PTLERec, Init(MySatName, MySatData1, MySatData2, 
MyCatNbr, MyEpoch)));
     end; {while not EOF}
   Close(fsat);
   Input_Satellite_List := sat_cnt;
end; {Procedure Input Satellite List}

[...]

BEGIN
   my_sats := 0;
   allowdupes := FALSE;
   writeln('initializing...');
   program_initialize('satsort');

   // initialize the list collection
   aTLEColl := New(PTLEColl, Init(2048,16));
   if aTLEColl = nil then
     begin
       writeln('*** ERROR: Can''t create TCollection');
       exit;
     end;
   aTLEColl^.duplicates := allowdupes;

   // load tles from all the available tle txt files
   load_files(data_drive+data_dir,'*.txt');

   // save current records in collection
   writeln;
   writeln('saving TLE collection to '+TLENewName);
   PrintRecords(aTLEColl,TLENewName);
   writeln('hit enter to continue...');
   repeat until keypressed;
   gigo := readkey;

   // time to go
   writeln;
   writeln('cleaning up and heading out...');
   writeln;
   writeln('aTLEColl^.FreeAll');
   aTLEColl^.FreeAll;
   writeln;
   writeln('dispose(aTLEColl,done)');
   dispose(aTLEColl,done);
   writeln('hit enter to terminate...');
   repeat until keypressed;
   gigo := readkey;

   program_end;
END.



More information about the fpc-pascal mailing list