All pastes #267946 Raw Edit

Anonymous

public text v1 · immutable
·published 2006-12-05 05:57 UTC
rendered paste body
with Ada.Text_IO; use Ada.Text_IO;

package body binarysearchtree is

	function toLower (c : character) return character renames Ada.characters.handling.to_lower;

		--  tolower - translates all alphabetic, uppercase characters
		--  in str to lowercase
	function toLower (Str : String10) return String is
		convert : String (str'Range);
	begin
		for x in  convert'Range loop
			convert (x) := toLower (str (x));
		end loop;
		return convert;
	end toLower;

	procedure InsertBinarySearchTree(Root:  in out BinarySearchTreePoint; custName: in String10; custPhone: String10 ) is
		p:binarySearchTreePoint:=root;
		q:binarySearchTreePoint:=root;
		t:binarySearchTreePoint;
		
	begin
		t:=new node;
		t.info.name:=custName;
		t.info.phoneNumer:=custPhone;
		t.rTag := true;
		t.rLink:=t;
		t.lTag:=false;
		t.rLink:=t;
		
		if root = null then
			root:=t;
		else
			loop
				if q/=null then
					if toLower(custName) < toLower(q.info.name) then
						if q.lLink=p then
							p:=q;
							exit;
						end if;
						p:=q;
						q:=q.lLink;
						elsif q.rTag = true then
							p:=q;
							q:=q.rLink;
						else
							p:=q;
							exit;
						end if;
					else
						exit;
				end if;
			end loop;
		
		
			if toLower(p.info.name) > toLower(custName) then
				t.lLink:=p.lLink;
				p.lTag := true;
				t.rLink:=p;
				t.rTag:=false;
				if t.lTag=true then
					t.lLink.rLink:=t; --check for child and rethread tree
				end if;
			elsif toLower(p.info.name) <= toLower(custName) then
				p.rLink:=t;
				p.rTag:=true;
				t.lLink:=p;
				t.lTag:=false;
				if t.rTag=true then
					t.rLink.lLink:=t; --check for child and rethread tree
				end if;
			end if;
		end if;
	end InsertBinarySearchTree;
		 

	-- This procedure locates a customer using a binary search.  A pointer is returned to the
-- customer record if they exist, otherwise a Null pointer is returned (in CustomerPoint).
	-- The search must be implemented iteratively.
	procedure FindCustomerIterative(Root: in BinarySearchTreePoint; CustomerName:  in String10; CustomerPoint:  out BinarySearchTreePoint) is
		p:binarySearchTreePoint:=root;
	begin
		loop
			if p=null then
				customerPoint:=p;
				exit;
			elsif toLower(p.info.name) = toLower(custName) then
				customerPoint:=p;
				exit;
			elsif toLower(p.info.name) > toLower(custName) then
				p:=p.lLink;
			elsif toLower(p.info.name) <= toLower(custName) then
				p:=p.rLink;
			end if;
		end loop;
	end FindCustomerIterative;
	
	-- This procedure locates a customer using a binary search.  A pointer is returned to the
-- customer record if they exist, otherwise a Null pointer is returned (in CustomerPoint).
	-- The search must be implemented recursively.
	procedure FindCustomerRecursive(Root: in BinarySearchTreePoint; CustomerName:  in String10; CustomerPoint:  out BinarySearchTreePoint) is
		p:binarysearchtreepoint;
	begin
			p:=root;
		if p /= null then
			if p.lTtag = True then 
				FindCustomerRecursive(p.Llink,customername);
			end if;
			if p.info.name = customername then
				customerPoint:=p;
				return;
			end if;
			if p.rTag = True then 
				FindCustomerRecursive(p.Rlink,customername);
			end if;
		end if;
			
	end FindCustomerRecursive;

	-- This function returns the address of the next node in â&#128;&#156;inorderâ&#128; taking advantage of threads.
-- The user may enter the  tree at any random location.  This is sometimes called an iteration 
-- function or iterater (no recursion).
	function InOrderSuccessor(TreePoint: in BinarySearchTreePoint) return BinarySearchTreePoint is
		p:binarySearchTreePoint;
		q:binarySearchTreePoint;
	begin
		p:=treePoint;
		q := p.rLink; 
		if p.rTag = false then
			p:=q;
		else
			while q.lTag = true loop
				q := q.lLink; 
			end loop;
			p:=q;
		end if;
		
		return p;
	end InOrderSuccessor;
	-- Access functions to return customer names and phone numbers.
	function CustomerName(TreePoint: in BinarySearchTreePoint) return String10 is
	begin
		return treePoint.info.name;
	end customerName;
	
	function CustomerPhone(TreePoint: in BinarySearchTreePoint) return String10 is
	begin
		return treePoint.info.phoneNumber;
	end customerPhone;
end binarysearchtree;