Re: [Seed7-users] Seed7 question

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Hi Anders,

You wrote in a private mail:

> I have a question which in a general way is: How to define a general type in a library
> which will be decided later on in the specific application?
> To illustrate what I am looking for I have created a test application and a library, ...

> The heap-library (heapV9.s7i) defines a heap structure and organises it as a binary tree.
> As it is now the heap-value needs to be a string. However I want it to be more dynamic and
> defined later on when using the heap-structure in an application.
> Until now I have not succeeded to solve it. I have been looking at how arrays can be built
> for different datatypes but have not been able to apply it for the heap-library.
> Maybe this is not the right way to do it.
> So my question is if there is a good way to do this?

In your mail you attached the files test19.sd7 and heapV9.s7i.
I have ommited these files here.

I post my answer also to see...@li... because I think that
it is also useful for others.

I assume that an abstract data type will probably fit your needs.

I have attached the heap-library heapV9x.s7i.
This library defines the function heapT which uses baseType as parameter.
The heapT function creates the actual structure and defines the functions for it.

Like with arrays a second call of heapT with the same type as baseType will refer to the same heapType.
This is done with the lines

    heapType := get_type(getfunc(heapT (attr baseType)));
    if heapType = void then

The then part of the if-statement is executed when there is no previous declaration of heapT with this baseType.
The line

      elmHashT := hash [integer] baseType;

defines elmHashT as helping type. The type elmHashT is only used inside of the heapT function.
The actual declarations are done inside a

      global
      ...
      end global;

construct. This makes sure that the declarations are done at a global level.

My solution does not need the type daEnum and the functions lessThan() and init().

---------- begin heapV9x.s7i ----------
const func type: heapT (in type: baseType) is func
  result
    var type: heapType is void;
  local
    var type: elmHashT is void;
  begin
    heapType := get_type(getfunc(heapT (attr baseType)));
    if heapType = void then
      global
      elmHashT := hash [integer] baseType;
      heapType := new struct
          var elmHashT: elmH is elmHashT.EMPTY_HASH;
          var integer: keyMax is 0;                                    # Max of key to the hash-table
          var array integer: ptrArr is [0 len 0] times integer.value;  # indexes to the element stored in elmH
        end struct;

      const func integer: length(in heapType: aHeap) is
	return length(aHeap.ptrArr);

      const func baseType: readMin(in heapType: aHeap) is func
	result
		var baseType: aResultVal is baseType.value;
	begin
		if length(aHeap.ptrArr) > 0 then
			aResultVal := aHeap.elmH[aHeap.ptrArr[minIdx(aHeap.ptrArr)]];
		end if;
	end func;

      const proc: swap(inout heapType: aHeap, in integer: id1, in integer: id2) is func
	local
		var integer: temp is integer.value;
	begin
		temp := aHeap.ptrArr[id1];
		aHeap.ptrArr[id1] := aHeap.ptrArr[id2];
		aHeap.ptrArr[id2] := temp;
	end func;

      const proc: add(inout heapType: aHeap, in baseType: aValue) is func
	local
		var integer: idx is integer.value;
		var integer: idx2 is integer.value;
		var integer: idh is integer.value;
	begin
		incr(aHeap.keyMax);
		incl(aHeap.elmH,aHeap.keyMax,aValue);
		aHeap.ptrArr &:= aHeap.keyMax;
		idx := maxIdx(aHeap.ptrArr);
		if idx > 0 then
			idx2 := (idx+1) div 2 - 1;  	# Has to calculate on pairs {even, odd} not {odd, even}
			while aHeap.elmH[aHeap.ptrArr[idx]] < aHeap.elmH[aHeap.ptrArr[idx2]] do
				swap(aHeap,idx,idx2);
				idx := idx2;
				idx2 := idx > 0 ? (idx+1) div 2 - 1 : 0; # Has to stop when reaches the root node
			end while;
		end if;
	end func;

      const func baseType: getFirst(inout heapType: aHeap) is func
	result
		var baseType: aResultVal is baseType.value;
	local
		var integer: elmPtr is integer.value;
		var integer: idx is integer.value;
		var integer: idx1 is integer.value;
		var integer: idx2 is integer.value;
	begin
		if length(aHeap.ptrArr) > 0 then
			elmPtr := remove(aHeap.ptrArr,minIdx(aHeap.ptrArr));
			aResultVal := aHeap.elmH[elmPtr];
			excl(aHeap.elmH,elmPtr);
			if length(aHeap.ptrArr) > 0 then
				elmPtr := remove(aHeap.ptrArr, maxIdx(aHeap.ptrArr));
				insert(aHeap.ptrArr,0,elmPtr);
				idx := minIdx(aHeap.ptrArr); # 0;
				idx1 := 1;
				idx2 := 2;
				while (idx1 <= maxIdx(aHeap.ptrArr) and
				      		aHeap.elmH[aHeap.ptrArr[idx1]] < aHeap.elmH[aHeap.ptrArr[idx]]) or
					(idx2 <= maxIdx(aHeap.ptrArr) and
						aHeap.elmH[aHeap.ptrArr[idx2]] < aHeap.elmH[aHeap.ptrArr[idx]]) do
					if idx2 <= maxIdx(aHeap.ptrArr) and
							aHeap.elmH[aHeap.ptrArr[idx2]] < aHeap.elmH[aHeap.ptrArr[idx1]] then
						swap(aHeap,idx,idx2);
						idx := idx2;
					else
						swap(aHeap,idx,idx1);
						idx := idx1;
					end if;
					idx1 := 2*idx+1;
					idx2 := 2*idx+2;
				end while;
			end if;
		end if;
	end func;

      end global;
    end if;
  end func;
---------- end heapV9x.s7i ----------

I have also modified the test program test19x.sd7 to use the new parameterized heapT.

---------- begin test19x.s7i ----------
$ include "seed7_05.s7i";
include "time.s7i";
include "array.s7i";
include "heapV9x.s7i";

const integer: MAX is 10000;

const type: intHeapType is heapT(integer);

const proc: main is func
	local
		var intHeapType: aHeap is intHeapType.value;
		var integer: idx is integer.value;
		var boolean: correct is TRUE;
		var array integer: checkArr is 0 times integer.value;
		var integer: aRVal is integer.value;
		var integer: heapValue is integer.value;
	begin
		writeln("\nAdding " <& MAX <& " values to the heap...");
		writeln("Before: " <& time(NOW));
		for idx range 1 to MAX do
			aRVal := rand(1,100);
			checkArr &:= aRVal;
			add(aHeap,aRVal); #The value added to the heap needs NOT to be converted to a string
		end for;
		writeln("After: " <& time(NOW));

		checkArr := sort(checkArr);

		writeln("\nChecking the heap...");
		writeln("Before: " <& time(NOW));
		idx := 1;
		while length(aHeap) > 0 do
			heapValue := getFirst(aHeap);
			#The value retrieved from the heap is an integer and needs NOT to be converted
			correct := correct and idx <= MAX and heapValue = checkArr[idx];
			incr(idx);
		end while;
		writeln("After: " <& time(NOW));
		if correct then
			writeln("Test result correct!");
		else
			writeln("Test result incorrect!");
		end if;

	end func;
---------- end test19x.s7i ----------

I hope that this is what you searched for.

Regards
Thomas

Re: [Seed7-users] Seed7 question

Interpreter and compiler for the Seed7 programming language.

Re: [Seed7-users] Seed7 question