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

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

03.06.2017, 16:46. Показов 856. Ответов 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
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
03.06.2017, 16:46
Ответы с готовыми решениями:

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

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

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

6
Почетный модератор
 Аватар для Puporev
64319 / 47615 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
03.06.2017, 16:58
Простой АВС или АВС.net?

Добавлено через 1 минуту
И не мешало бы приложить исходный текстовый файл и написать текст задания.
0
0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
03.06.2017, 17:35  [ТС]
Задание: написать программу Дерево решений. Например : есть 20 шариков.9 из них белого цвета и 11 желтого цвета
Переделать данную программу на Pascal АВС.net
Текстовый файл прикрепила ниже
Вложения
Тип файла: txt Ball.txt (118 байт, 4 просмотров)
0
Почетный модератор
 Аватар для Puporev
64319 / 47615 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
03.06.2017, 17:47
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  [ТС]
Puporev, Огромное,огромное спасибо!!!!Очень благодарна. Если будут вопросы по программе напишу

Добавлено через 3 минуты
Puporev, их просто можно было удалить? и она будет работать правильно после этого?
0
Почетный модератор
 Аватар для Puporev
64319 / 47615 / 32743
Регистрация: 18.05.2008
Сообщений: 115,167
03.06.2017, 17:57
Она запускается без ошибок, а что она делает понятия не имею и не хочу.
1
0 / 0 / 0
Регистрация: 01.06.2017
Сообщений: 5
03.06.2017, 17:58  [ТС]
Puporev,
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
03.06.2017, 17:58
Помогаю со студенческими работами здесь

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

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

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

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

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


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

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

Новые блоги и статьи
Отчёт о затраченных материалах за определенный период с макетом печатной формы
Maks 21.04.2026
Отчёт из решения ниже размещён в конфигурации КА2. Задача: показать затраченные материалы за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В качестве. . .
Отчёт о спецтехнике находящейся в ремонте
Maks 20.04.2026
Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .
Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)"
Hrethgir 19.04.2026
Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .
Запрет удаления строк ТЧ документа при определённом условии
Maks 19.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .
Модель заражения группы наркоманов
alhaos 17.04.2026
Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .
Мысли в слух. Про "навсегда".
kumehtar 16.04.2026
Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .
My Business CRM
MaGz GoLd 16.04.2026
Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .
Знаешь почему 90% людей редко бывают счастливыми?
kumehtar 14.04.2026
Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru