Unit jack;
Interface
Type
recoo = Record
wrd : string[50];
emo : real;
End;
tab = array[1..50] Of recoo;
Function clean(l:String) : string;
Function fill(l:String;Var table:tab) : real;
Function lengtho(l:String) : integer;
Function tlength(t:tab) : integer;
Procedure delreptab(Var t:tab);
Procedure deletee(Var t:tab;l:integer);
Procedure sep(Var t,t1,t2:tab);
Procedure hertz(Var t:tab);
Procedure fillt(l:String;t:tab);
Procedure readt(Var t:tab;n:integer);
//--------------------------------------------------------------------------
Implementation
Function clean(l:String) : string;
Var
j,i : integer;
c1,clower,cspace,cupper : boolean;
Begin
j := 1;
While j<=length(l) Do
Begin
clower := ((ord(l[j])>64)And(ord(l[j])<91));
cspace := ord(l[j])=32;
cupper := ((ord(l[j])>96 )And (ord(l[j])<123));
If Not(clower Or cspace Or cupper) Then
delete(l,j,1);
If (clower Or cspace Or cupper) Then
j := j+1;
End;
j := 1;
While j<=length(l) Do
Begin
If ( (l[j]=' ') And (ord(l[j+1])<65 ) ) Then
delete (l,j,1)
Else
j := j+1;
End;
clean := l;
End;
//---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------//-------------------
Function fill(l:String; Var table:tab) : real;
Var
i,j : integer;
answer : real;
Begin
For i:=1 To 50 Do
table[i].emo := 0;
j := 1;
For i:=1 To length(l) Do
Begin
If l[i]<>' ' Then
table[j].wrd := table[j].wrd+l[i]
Else
j := j+1;
End;
If (table[j].wrd='positive') Then
fill := 1
Else
fill := -1;
answer := fill(l,table);
For i:=1 To j Do
Begin
table[i].emo := table[i].emo+answer;
End;
End;
//----------------------------------------------------------------------------------------------
Function lengtho(l:String) : integer;
Var
i,j : integer;
Begin
j := 1;
For i:=1 To length(l) Do
Begin
If (l[i]=' ' ) Then
j := j+1;
End;
lengtho := j;
End;
//---------------------------------------------------------------------------------------------------
Function tlength(t:tab) : integer;
Var
i,j : integer;
empty : boolean;
Begin
empty := t[i].wrd='';
i := 1;
While ((i<=50) And (Not(empty))) Do
Begin
j := j+1
End;
tlength := j;
End;
//--------------------------------------------------------------------------------------------------
Procedure delreptab(Var t:tab);
Var
j,k,n : integer;
Begin
For j:=1 To tlength(t) Do
Begin
For k:=j To tlength(t) Do
Begin
If t[j].wrd=t[k].wrd Then
Begin
If t[j].emo=t[k].emo Then
Begin
t[j].emo := t[j].emo+t[j].emo;
For n:=j To tlength(T) Do
t[n] := t[n+1];
End;
End;
End;
End;
End;
//---------------------------------------------------------------------------------------------------
Procedure deletee(Var t:tab;l:integer);
Var
i,j : integer;
Begin
For i:=l To 50 Do
Begin
t[i] := t[i+1];
End;
End;
//--------------------------------------------------------------------------------------------------
Procedure sep(Var t,t1,t2:tab);
Var
i,k,j : integer;
Begin
For i:=1 To 50 Do
Begin
j := 1;
k := 1;
If t[i].emo>0 Then
Begin
t1[j] := t[i];
j := j+1;
End;
if t[i].emo<0 then ////this is the ligne 172 <<((------------------------(<
Begin
t2[k] := t[i];
k := k+1;
End;
End;
End;
//---------------------------------------------------------------------------------------------------
Procedure hertz (Var t:tab);
Var
i,j : integer;
k : real;
Begin
For i:=1 To 50 Do
k := t[i].emo;
Begin
For j:=i To 50 Do
Begin
If t[i].wrd =t[j].wrd Then
Begin
t[i].emo := t[i].emo+k;
deletee(t,j);
End;
End;
End;
End;
//---------------------------------------------------------------------------------------------------
Procedure readt(Var t:tab;n:integer);
Var
i,j : integer;
k : real;
s : string;
Begin
For i:=1 To n Do
Begin
readln(s);
t[i].wrd := s;
readln(k);
t[i].emo := k;
End;
End;
//---------------------------------------------------------------------------------------------------
Procedure fillt(l:String;t:tab);
Var
i,j : integer;
Begin
For i:=1 To length(l) Do
Begin
j := 1;
If l[i]<>' ' Then
t[j].wrd := t[j].wrd+l[i]
Else
j := j+1;
End;
End;
End.
Recent
