Программа Дерево решений. Уже написана на 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.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д