Программа Дерево решений. Уже написана на Delphi. А мне надо на PascalABC. Что делать с модулями? - PascalABC.NET

Узнай цену своей работы

Формулировка задачи:

Помогите,пожалуйста, переделать на Pascal ABC.

Решение задачи: «Программа Дерево решений. Уже написана на Delphi. А мне надо на PascalABC. Что делать с модулями?»

textual
Листинг программы
//убрал Делфийские прибамбасы
Type 
Tball = record 
x : integer; 
color : string[5]; 
end; 
 
PTballNode = ^TballNode; 
TballNode = record 
x : integer; 
color : string[5]; 
l, r : PTballNode; 
e : integer; 
end; 
TMassBall = array of Tball; 
 
Var 
Blue, Red : integer; 
 
{ 
Function FindRed (Mass : TMassBall; first, last : integer) : integer; 
var 
i : integer; 
 
begin 
result := 0; 
for i := first to last - 1 do 
if Mass[i].color = 'r' then 
inc (result); 
end; } 
 
 
 
Function Entropy (Mass : TMassBall; first, last : integer) : double; 
var 
BallsOne, {один цвет} BallsTwo, {другой цвет} AllBalls {Общее кол-во элементов}, 
Red, Blue, i, j : integer; 
 
begin 
Red := 0; 
Blue := 0; 
result := 0; 
for j := first to last do 
if Mass[j].color = 'r' then 
inc(Red) 
else inc(Blue); 
AllBalls := last - first + 1; 
if red <> 0 then 
result := -(Red/AllBalls)*log2(Red/AllBalls); 
if Blue <> 0 then 
result := Result - Blue/AllBalls * log2(Blue/AllBalls); 
end; 
 
 
 
Procedure CreateTree (var root : PTballNode; Mass : TmassBall; first, last : integer); // Индексыы и корень 
var 
i : integer; 
SdMax, S0, S1, S2, Sd : double; 
iMax : integer; 
 
 
begin 
S0 := Entropy (Mass, first, last); 
if S0 = 0 then 
begin 
new (root); 
root^.l := nil; 
root^.r := nil; 
Root^.x := first; 
Root^.e := last; 
root^.color := Mass[First].color; 
end 
else 
begin 
SdMax := -1; 
iMax := 0; 
for i := first to last - 1 do 
begin 
S1 := Entropy (Mass, first, i); 
S2 := Entropy (Mass, i + 1, last); 
Sd := S0 - ((i - first + 1)* S1)/(last - first) - ((last - i )*s2)/(last - first); 
if Sd > SdMax then 
begin 
iMax := i; 
SdMax := Sd; 
end; 
end; 
new (root); 
root^.x := imax; 
CreateTree(Root^.l,Mass,first, iMax); 
CreateTree(Root^.r,Mass,iMax + 1, last); 
 
end; 
end; 
 
 
Procedure Print (root : PTballNode; Offset : integer); 
begin 
 
if root <> nil then 
begin 
Print (root^.r, offset + 4); 
if (root^.l = nil) and (root^.r = nil) then 
writeln (' ' : offset, root^.color, '[', root^.x, ',', root^.E, ']') 
else 
writeln (' ' : offset, root^.x); 
Print (root^.L, offset + 4); 
end; 
end; 
 
 
 
Var 
f : textfile; 
s : char; 
str : string; 
root : PTballNode = nil; 
Balls : TmassBall; 
 
BeGIN 
assign(f,'D:\Ball.txt'); //заменил assignfile на assign
reset(f); 
while not eof(f) do 
begin 
Setlength(Balls, length(Balls) + 1); 
readln(f,Balls[Length(Balls) - 1].x, str); 
Balls[Length(Balls) - 1].color := Trim(str); 
end; 
close (f); 
CreateTree (root,Balls, 0, length(Balls)-1); 
Print (root, 0); 
readln; 
END.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 3.917 из 5
Похожие ответы