0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
1

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

03.06.2017, 16:46. Показов 588. Ответов 6
Метки нет (Все метки)

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
program DoP_777; 
 
{$APPTYPE CONSOLE} 
 
{$R *.res} 
 
uses 
System.SysUtils, Math; 
 
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 
assignfile (f,'D:\Ball.txt'); 
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.
Добавлено через 1 минуту
Помогите,пожалуйста, переделать на Pascal ABC.
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
03.06.2017, 16:46
Ответы с готовыми решениями:

Что мне делать или что надо знать перед тем как начать изучение яз.программирования С/С++?
Я пока вообще не умею программировать.Сначала хотел с бейсика или паскаля.Но многие советуют...

Разбираюсь с outlook. что не так? код не мой но по сути должен делать что мне надо, но он ничего не делает
Function ListOLInbox() 'спиcок писем в папке &quot;входящие&quot; Dim OL_App As Outlook.Application Dim...

На каком языке написана программа Надо перевести на С++ или объяснить что тут происходит по пунктам
using System; using System.Collections.Generic; using System.ComponentModel; using System.Data;...

Что и как делать после того как была написана программа
Объясните, пожалуйста, практически &quot;на пальцах&quot;, что и как делать после того, как была написана...

6
Почетный модератор
64234 / 47536 / 32737
Регистрация: 18.05.2008
Сообщений: 115,182
03.06.2017, 16:58 2
Простой АВС или АВС.net?

Добавлено через 1 минуту
И не мешало бы приложить исходный текстовый файл и написать текст задания.
0
0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
03.06.2017, 17:35  [ТС] 3
Задание: написать программу Дерево решений. Например : есть 20 шариков.9 из них белого цвета и 11 желтого цвета
Переделать данную программу на Pascal АВС.net
Текстовый файл прикрепила ниже
Вложения
Тип файла: txt Ball.txt (118 байт, 4 просмотров)
0
Почетный модератор
64234 / 47536 / 32737
Регистрация: 18.05.2008
Сообщений: 115,182
03.06.2017, 17:47 4
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
//убрал Делфийские прибамбасы
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.
0
0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
03.06.2017, 17:54  [ТС] 5
Puporev, Огромное,огромное спасибо!!!!Очень благодарна. Если будут вопросы по программе напишу

Добавлено через 3 минуты
Puporev, их просто можно было удалить? и она будет работать правильно после этого?
0
Почетный модератор
64234 / 47536 / 32737
Регистрация: 18.05.2008
Сообщений: 115,182
03.06.2017, 17:57 6
Она запускается без ошибок, а что она делает понятия не имею и не хочу.
1
0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
03.06.2017, 17:58  [ТС] 7
Puporev,
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
03.06.2017, 17:58
Помогаю со студенческими работами здесь

Мне нужно сделать так что кнопка вычисления смотрела сумму и вес и потом выдавала разряд, делать надо с условием.
Делаю проект по спорту. Помогите сделать простенькое вычисление. А то запутался совсем. Мне нужно...

Программа уже написана, а понять не могу(
Дан двумерный массив n*m, заполненный случайными числами. Определить, есть ли в данном массиве...

Указываю файл шрифта из папки, а программа мне возвращает шрифт Arial. Что делать?
Указываю файл шрифта из папки, а программа мне возвращает шрифт Arial. Что делать? Почему не...

Нужно написать алгоритм к программе в C#, сама программа уже написана
Не могу написать алгоритм к программе в C#. Вот условие для написания самой программы: Написать...

нужно вбить массив в класс Array (Программа уже написана)
помогите пожалуйста. у меня есть програмка,но нужно сделать ее так чтобы создание массива было...

Помогите пожалуйста преобразовать функцию в деструктор. (Полностью рабочая программа уже написана)
Заранее благодарен всем кто поможет. Здравствуйте, учусь на первом курсе и только разбираюсь с...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru