{+doc
+NOMBRE: OferDem
+CREACION: 31.3.1992
+AUTORES:  rch,rz
+REGISTRO:
+TIPO: Unidad Pascal.
+PROPOSITO:  Definici˘n de los procemientos para las transacciones
	de energĦa utilizadas por el (Director) en el progrma SimEnerg.
+PROYECTO: AUTONOMA.

+REVISION:
+AUTOR:
+DESCRIPCION:
-doc}
Unit OfeDem02;
interface
uses
	SysUtils, Listas, Actores, VGlbs02, xMatDefs;

procedure RecogerOfertasYDemandas;
procedure ResolverTransacciones;
procedure LimpiarVariablesDeUltimos;

procedure AlInicio;
procedure AlFinal;

implementation

{$IFDEF WR_OFERDEM}
var
  fsal_oferdem: textfile;
{$ENDIF}


procedure LimpiarVariablesDeUltimos;
var
	p:nodoPtr;
begin
	p:=Escenario.ultimo;
	while p<>nil do
	begin
		TActor(p^.item).LimpiarUltimos;
		p:=Escenario.anterior(p);
	end;
end;

procedure RecogerOfertasYDemandas;
var
	k:integer;
	p:nodoPtr;
	F:TFicha;
	F2: TFicha;

begin
	F:= TFicha.Create(nil);

	for k:= 1 to MaxNumPrior do
	begin
		Ofertas[k].Free;
		Demandas[k].Free;
	end;

	for k:= 1 to MaxNumPrior do
	begin
		Ofertas[k]:= TLista.Create;
		Demandas[k]:= TLista.Create;
	end;

	p:=Escenario.ultimo;
	while p<>nil do
	begin

		if TActor(p^.item).Ofertar(F) then
		begin
			f2:= TFicha.Create( F);
			Ofertas[F.prioridad].append( f2 );
		end;

		if TActor(p^.item).Demandar(F) then
		begin
			f2:= TFicha.Create(F);
			Demandas[F.prioridad].append(f2);
		end;
		p:=Escenario.anterior(p);
	end;
end;


function TotalEnergiaNivel(var Cajonera: t_Cajones; k:integer):NReal;
var
	p:nodoPtr;
	acum:NReal;
begin
	acum:=0;
	p:=Cajonera[k].ultimo;
	while p<>nil do
	begin
		acum:=acum+ TFicha(p^.item).energia;
		p:=Cajonera[k].anterior(p)
	end;
	TotalEnergiaNivel:=acum;
end;



procedure RechazoOfertasNivel( Nivel:integer);
var
	p:nodoPtr;
	actor: TActor;
begin
	p:=Ofertas[Nivel].ultimo;
	while p<> nil do
	begin
		actor:= TFicha(p^.item).IdAct as TActor;
		actor.RechazoOferta(TFicha(p^.item));
		p:=Ofertas[Nivel].anterior(p)
	end;
end;


procedure NotificarAceptacionOfertasNivel( Nivel:integer);
var
	p:nodoPtr;
	actor: TActor;
begin
	p:=Ofertas[Nivel].ultimo;
	while p<> nil do
	begin
		actor:= TFicha(p^.item).IdAct as TActor;
		actor.AceptoOferta(TFicha(p^.item));
		p:=Ofertas[Nivel].anterior(p)
	end;
end;



procedure ResolverExceso(
	IdxO:integer; { Lugar donde nos paramos }
	ORN:NReal { Oferta Restante en el nivel IdxO }
	);
var
	OTN,
	factor: NReal;
	p: nodoPtr;
	k:integer;

begin
  factor:= 0;
	if Abs(ORN) > AsumaCero then
	begin
		OTN:= TotalEnergiaNivel(Ofertas,IdxO);
		factor:= ORN/OTN;
		p:= Ofertas[IdxO].ultimo;
		while p<>nil do
		begin
			TFicha(p^.item).energia:=TFicha(p^.item).energia*factor;
			p:= Ofertas[IdxO].anterior(p);
		end;
	end
	else
		Inc(IdxO);


	For k:= IdxO to MaxNumPrior do
		RechazoOfertasNivel(k);

	if abs(ORN)>asumaCero then
	begin
		p:= Ofertas[IdxO].ultimo;
		factor:=(1-factor) /factor;
		while p<>nil do
		begin
			TFicha(p^.item).energia:=TFicha(p^.item).energia*factor;
			p:= Ofertas[IdxO].anterior(p);
		end;
	end
	else Dec(IdxO);

	NotificarAceptacionOfertasNivel(IdxO);


end;


{--------------}

procedure RechazoDemandasNivel( Nivel:integer);
var
	p:nodoPtr;
	actor: TActor;
begin
	p:=Demandas[Nivel].ultimo;
	while p<> nil do
	begin
		actor:= TFicha(p^.item).IdAct as TActor;
		actor.RechazoDemanda(TFicha(p^.item));
		p:=Demandas[Nivel].anterior(p)
	end;
end;



procedure NotificarAceptacionDemandasNivel( Nivel:integer);
var
	p:nodoPtr;
	actor: TActor;
begin
	p:=Demandas[Nivel].ultimo;
	while p<> nil do
	begin
		actor:= TFicha(p^.item).IdAct as TActor;
		actor.AceptoDemanda(TFicha(p^.item));
		p:=Demandas[Nivel].anterior(p)
	end;
end;



procedure ResolverDeficit(
	IdxD:integer; { Lugar donde nos paramos }
	DRN:NReal { Demanda Restante en el nivel IdxD }
	);
var
	DTN,
	factor: NReal;
	p: nodoPtr;
	k:integer;


begin

		DTN:= TotalEnergiaNivel(Demandas,IdxD);
		if Abs(DTN) > AsumaCero then
			factor:= DRN/DTN
		else factor:= 0;

	p:= Demandas[IdxD].ultimo;

	while p<>nil do
	begin
		TFicha(p^.item).energia:=TFicha(p^.item).energia*factor;
		p:= Demandas[IdxD].anterior(p);
	end;

	for k:= IdxD downto 1 do
		RechazoDemandasNivel(k);


	p:= Demandas[IdxD].ultimo;

	if abs(factor) >AsumaCero then
	begin
		factor:=(1-factor)/factor;
		while p<>nil do
		begin
			TFicha(p^.item).energia:=TFicha(p^.item).energia*factor;
			p:= Demandas[IdxD].anterior(p);
		end;
		NotificarAceptacionDemandasNivel(IdxD);
	end;
end;

procedure RRDO( IdxO:integer);
var
	k:integer;
begin
	for k:= IdxO to MaxNumPrior do
	RechazoOfertasNivel(k);
end;

procedure RRDD( IdxD:integer);
var
	k:integer;
begin
	for k:= IdxD downto 1 do
		RechazoDemandasNivel(k);
end;


procedure ResolverTransacciones;
var
	acum_O,
	acum_D:NReal;
	Oidx,Didx:integer;
	termine:boolean;

{$IFDEF WR_OFERDEM}
  OfertaX, DemandaX: NReal;
  kOferDem: Integer;
{$ENDIF}
begin

	Oidx:=1; { indice de la oferta }
	Didx:=MaxNumPrior; { indice en las prioridades }

	termine:=false;


	acum_O:=TotalEnergiaNIvel(Ofertas,Oidx);
	acum_D:=TotalEnergiaNivel(Demandas,Didx);



  {$IFDEF WR_OFERDEM}
  for kOferDem := 1 to MaxNumPrior do
  begin
    OfertaX:= TotalEnergiaNivel( Ofertas, kOferdem );
    write( fsal_oferdem, #9, OfertaX:12:2 );
  end;
  for kOferDem := 1 to MaxNumPrior do
  begin
    DemandaX:= TotalEnergiaNivel( Demandas, kOferdem );
    write( fsal_oferdem, #9, DemandaX:12:2 );
  end;
  writeln( fsal_oferdem );

  {$ENDIF}

	while not(termine) do
	begin
		if acum_O > acum_D then
		begin
			NotificarAceptacionDemandasNivel(Didx);
			acum_O := acum_O - acum_D;
			Dec(Didx);

 {???}	if Didx < Oidx{1} then { cambio 27.8.92 }
			begin
				{
				if abs(acum_O)>AsumaCero then
				}
				ResolverExceso(Oidx,acum_O);

				RRDD( Didx );
				termine := true;
			end
			else
				acum_D := TotalEnergiaNivel(Demandas,Didx)
		end
		else
		begin
			NotificarAceptacionOfertasNivel(Oidx);
			acum_D := acum_D - acum_O;
			Inc(Oidx);

{???}		if Oidx > Didx {MaxNumPrior} then {cambio 27.8.92}
			begin
			 {	if acum_D then }
				ResolverDeficit(Didx,acum_D);

				RRDO(Oidx);
				termine := true;
			end
			else
				acum_O := TotalEnergiaNivel(Ofertas,Oidx)
		end
	end
end;


procedure AlInicio;
var
	k:integer;
begin
	for k:= 1 to MaxNumPrior do
	begin
		Ofertas[k]:= TLista.Create;
		Demandas[k]:= TLista.Create;
	end;
{$IFDEF WR_OFERDEM}
  assign(  fsal_oferdem, 'oferdem.xlt' );
  rewrite( fsal_oferdem );

  for k := 1 to MaxNumPrior do
  begin
    write( fsal_oferdem, #9, 'O'+IntToStr( k ) );
  end;
  for k := 1 to MaxNumPrior do
  begin
    write( fsal_oferdem, #9, 'D'+ IntToStr(k));
  end;
  writeln( fsal_oferdem );

{$ENDIF}
end;


procedure AlFinal;
begin
{$IFDEF WR_OFERDEM}
  closefile( fsal_oferdem );
{$ENDIF}
end;

end.


