Nghiên cứu xây dựng hệ thống điều độ kế hoạch sản xuất công ty unilever việt nam

ðại Học Quốc Gia TP. Hồ Chí Minh
Trường ðại Học Bách Khoa TP. Hồ Chí Minh
------------------

NGUYỄN NGỌC NGƠN

NGHIÊN CỨU XÂY DỰNG HỆ THỐNG ðIỀU ðỘ KẾ
HOẠCH SẢN XUẤT CÔNG TY UNILEVER VIỆT NAM
Chuyên ngành : Kỹ Thuật Hệ Thống Công Nghiệp

LUẬN VĂN THẠC SĨ

TP. HỒ CHÍ MINH, tháng 11 năm 2008


CƠNG TRÌNH ðƯỢC HỒN THÀNH TẠI
TRƯỜNG ðẠI HỌC BÁCH KHOA
ðẠI HỌC QUỐC GIA TP HỒ CHÍ MINH
Cán bộ hướng dẫn khoa học : Tiến Sĩ NGUYỄN TUẤN ANH

(Ghi rõ họ, tên, học hàm, học vị và chữ ký)
Cán bộ chấm nhận xét 1 :

(Ghi rõ họ, tên, học hàm, học vị và chữ ký)
Cán bộ chấm nhận xét 2 :

(Ghi rõ họ, tên, học hàm, học vị và chữ ký)

Luận văn Thạc sĩ ñược bảo vệ tại HỘI ðỒNG CHẤM BẢO VỆ LUẬN VĂN
THẠC SĨ TRƯỜNG ðẠI HỌC BÁCH KHOA, ngày 27 tháng 12 năm 2008

TRƯỜNG ðẠI HỌC BÁCH KHOA

CỘNG HÒA XÃ HỘI CHỦ NGHĨA VIỆT NAM

PHÒNG ðÀO TẠO SðH

ðỘC LẬP – TỰ DO – HẠNH PHÚC

Tp. HCM, ngày 30 tháng 06 năm 2008
NHIỆM VỤ LUẬN VĂN THẠC SĨ
Họ tên học viên : Nguyễn Ngọc Ngôn

Phái : Nam

Ngày, tháng, năm sinh : 29/ 02/ 1976

Nơi sinh : Cần Thơ

Chuyên ngành : Kỹ Thuật Hệ Thống Công Nghiệp
I- TÊN ðỀ TÀI : Nghiên cứu xây dựng hệ thống điều độ kế hoạch sản xuất
cơng ty Unilever Việt Nam.
II- NHIỆM VỤ VÀ NỘI DUNG:
-

Tìm hiểu về thực trạng điều độ tại cơng ty.

-

Tìm hiểu về giải thuật GA, ứng dụng GA trong ñiều ñộ và ñiều ñộ ña

mục tiêu.

-

So sánh ñánh giá ưu khuyết ñiểm của các giải thuật GA.

-

Ứng dụng GA vào việc giải quyết bài toán thực tế.

III- NGÀY GIAO NHIỆM VỤ: 30/ 06/ 2008
IV- NGÀY HOÀN THÀNH NHIỆM VỤ : 30/ 11/ 2008
V- CÁN BỘ HƯỚNG DẪN : TIẾN SĨ NGUYỄN TUẤN ANH
CÁN BỘ HƯỚNG DẪN

CN BỘ MÔN QL.CHUYÊN NGÀNH

(Học hàm, học vị, họ tên và chữ ký)

Tiến Sĩ NGUYỄN TUẤN ANH
Nội dung và ñề cương luận văn thạc sĩ ñã ñược hội ñồng chun ngành thơng qua
Ngày 30 tháng 06 năm 2008

TRƯỞNG PHỊNG ðT- SðH

TRƯỞNG KHOA QL CHUYÊN NGÀNH


LỜI CẢM ƠN

Tôi xin chân thành cám ơn tiến sĩ Nguyễn Tuấn Anh đã tận tình hướng dẫn tơi
thực hiện luận văn.
Xin chân thành biết ơn các thầy cô trong bộ mơn Kỹ Thuật Hệ Thống Cơng
Nghiệp đã hướng dẫn, cung cấp kiến thức trong thời gian tôi học tập tại trường
và truyền lịng đam mê nghiên cứu khoa học cho tôi. Các bạn trong lớp cao
học ISE20006, chúng ta có một tập thể tuyệt vời, hỗ trợ nhau trong lúc học tập,
nghiên cứu và trong cuộc sống.
Cám ơn ban quản lý xưởng sản phẩm lỏng – nhà máy Unilever Việt Nam. Các
anh Võ Cự Vinh, Trần Anh Dũng, anh Trung và chị Hịa đã nhiệt tình hỗ trợ tơi
khi tìm hiểu hệ thống sản xuất và lập kế hoạch của nhà máy.
Cám ơn ba mẹ động viên khuyến khích và gia đình đã chia xẻ gánh nặng trong
cuộc sống để tơi có điều kiện hồn thành chương trình học tại trường và thực
hiện luận văn này.


MỤC LỤC
Trang

1.

Tổng quan
1.1 ðặt vấn ñề
1.2 Mục tiêu luận văn
1.3 Phạm vi và giới hạn
1.4 Bố cục luận văn
2. Cơ sở lý thuyết
2.1 Lý thuyết ñiều ñộ trong sản xuất và dịch vụ
2.1.1 Các mơ hình sản xuất
2.1.1.1 Mơ hình sản xuất
2.1.1.2 Mơ hình thiết bị

2.1.1.3 Các đặc điểm của q trình và ràng buộc
2.1.1.4 Các mục tiêu trong điều ñộ sản xuất
2.1.2 Các luật ñiều ñộ kinh nghiệm
2.1.2.1 Các luật cơ bản
2.1.2.2 Các luật kết hợp
2.1.3 Các giải thuật
2.1.3.1 Các giải thuật xây dựng
2.1.3.2 Các giải thuật cải tiến
2.2 Tối ưu hóa đa mục tiêu
2.2.1 Bài tốn tối ưu ña mục tiêu
2.2.1.1 Thiết lập bài toán
2.2.1.2 Các lời giải tối ưu và hiệu quả
2.2.2 Các phương pháp tối ưu ña mục tiêu
2.2.2.1 Cách tiếp cận một hàm mục tiêu
2.2.2.2 Phương pháp mục tiêu toàn cục (Global Criterion
Method)
2.2.2.3 Phương pháp quy hoạch thỏa hiệp (Compromise
Programming)
2.2.2.4 Quy hoạch De Novo
2.2.2.5 Quy hoạch mục tiêu (Goal Programming , GP)
2.3 Các nghiên cứu liên quan
2.3.1 ðiều độ với giải thuật tìm kiếm vùng cấm (Tarbu Search)
2.3.2 ðiều độ với thuật tốn ủ kim loại (Simulated Annealing)
2.3.3 Giải thuật ñàn kiến (Ant Colony)
2.3.4 Giải thuật di truyền
2.3.4.1 Giải thuật di truyền AWGA (Adaptive Weight)
2.3.2.3 Giải thuật di truyền SPGA (Strength Pareto)
2.3.4.3 Giải thuật di truyền iAWGA (Interactive Adaptive
Weight)
3. Khảo thực tế tại công ty Unilever Việt Nam – xưởng sản phẩm lỏng

3.1 Giới thiệu tổng quan công ty Unilever Việt Nam
3.2 Hệ thống sản xuất
3.3 Quy trình lập kế hoạch sản xuất
3.4 Bài tốn thực tế
Trang 1

6
6
7
7
7
9
9
10
10
11
11
11
12
12
13
13
13
14
16
16
16
16
17
17

18
19
19
19
21
21
21
21
22
23
24
27
30
30
31
36
37


4.

Xây dựng chương trình
4.1 Mơ hình tốn học
4.2 Phương pháp mã hóa
4.3 Phương pháp lai tạo
4.4 Phương pháp đột biến
4.5 Cơ chế gán hàm thích nghi fitness và chọn lựa
4.5.1 Theo thuật toán awGA (Adaptive Weight GA)
4.5.2 Theo thuật toán i-awGA (Interactive Adaptive Weight)
4.5.3 Chiến lược Elitist cho awGA và i-awGA

4.5.4 Theo thuật tốn spEA (Strength Pareto Evolutionary Algorithm)
4.5.5 Tính ñộ hữu ích (utilization) của lời giải
4.6 ðiều kiện dừng
4.7 Chương trình điều độ kế hoạch sản xuất
4.7.1 Cấu trúc cơ sở dữ liệu
4.7.2 Sơ đồ khối chương trình
4.7.3 Hoạt ñộng của chương trình
5.
Thiết kế thực nghiệm và ñánh giá hiệu quả chương trình
5.1 Thiết kế thực nghiệm tìm bộ thơng số phù hợp chương trình.
5.1.1. Thiết kế thực nghiệm 2k cho chương trình i-awGA
5.1.2. Thiết kế thực nghiệm 2k cho chương trình awGA
5.1.3. Thiết kế thực nghiệm 2k cho chương trình spEA

5.2 ðánh giá hiệu quả các chương trình
5.2.1 So sánh với chương trình Lekin
5.2.2 So sánh với thực tế và so sánh các chương trình với nhau
5.2.3 Kết luận
6. Kết luận và hướng phát triển của ñề tài
6.1 Kết luận
6.2 ðiểm hạn chế và hướng phát triển của ñề tài
Tài liệu tham khảo
Phụ lục A: Giới thiệu phần mềm Lekin
Phụ lục B: Giới thiệu phần mềm Minitab
Phụ lục C: Mã nguồn chương trình điều độ

Trang 2

38
38

39
39
40
40
41
42
42
43
45
45
47
47
50
50
53
53
53
58
62
68
68
71
77
78
78
78
80


DANH SÁCH HÌNH

Tên hình
Chương 2
Hình 2.1
Hình 2.2
Hình 2.3
Hình 2.4
Hình 2.5
Hình 2.6
Hình 2.7
Hình 2.8
Chương 3
Hình 3.1
Hình 3.2
Chương 4
Hình 4.1
Hình 4.2
Hình 4.3
Hình 4.4
Hình 4.5
Hình 4.6
Hình 4.7
Hình 4.8
Hình 4.9
Hình 4.10
Hình 4.11
Hình 4.12
Hình 4.13
Hình 4.14
Hình 4.15
Hình 4.16

Hình 4.17
Chương 5
Hình 5.1
Hình 5.2
Hình 5.3
Hình 5.4
Hình 5.5
Hình 5.6
Hình 5.7
Hình 5.8
Hình 5.9
Hình 5.10

Trang

Lưu đồ dịng thơng tin trong hệ thống sản xuất
Các loại mơ hình sản xuất
Minh họa cho khái niệm hiệu quả
Một trường hợp không tồn tại vùng lời giải khả thi
Minh họa tính sức mạnh và ñộ phù hợp với bài toán maximum
2 mục tiêu
So sánh cơ chế tính độ phù hợp của spEA và spEA2
Minh họa toán tử truncation với N’ = 5
Minh họa giá trị ñộ phù hợp bởi các cơ chế gán ñộ phù hợp
khác nhau

9
10
17
18

25

Quy trình sản xuất
Lưu đồ q trình lên kế hoạch sản xuất

31
36

Phương pháp mã hóa
Phương pháp lai tạo
Mapping gen thừa và thiếu
Phương pháp đột biến
Lưu đồ chương trình theo awGA và i-awGA
Chiến lược Elitist
Lưu đồ chương trình theo spEA
Số thế hệ tối đa maxGen của các chương trình
Bảng lưu các cơng việc cần điều độ
Bảng kết quả điều ñộ
Bảng lưu giá thành sản phẩm, tính chi phí khởi ñộng và giá trị
ñơn hàng
Bảng lưu chi phí khởi ñộng
Bảng lưu các thơng số chương trình
Sơ đồ khối chương trình ñiều ñộ kế hoạch sản xuất
Giao diện nhập các công việc cần điều độ
Giao diện chương trình điều độ cơng việc
Giao diện cài đặt thơng số cho chương trình

39
40
40

40
41
43
43
46
47
48
48

Main Effect cho tổng chi phí – i-awGA
Interaction cho tổng chi phí– i-awGA
Chu tuyến Popsize và Pm– i-awGA
Chu tuyến A và Pm– i-awGA
Chu tuyến A và Pc– i-awGA
Main Effect cho tổng chi phí-awGA
Interaction cho tổng chi phí-awGA
Chu tuyến PopSize và Pm-awGA
Chu tuyến PopSize và A-awGA
Main Effect cho tổng chi phí - spEA

56
56
57
57
57
60
61
61
62
65

Trang 3

26
27
29

49
49
50
50
51
52


Hình 5.11
Hình 5.12
Hình 5.13
Hình 5.14
Hình 5.15
Hình 5.16
Hình 5.17
Hình 5.18
Hình 5.19
Hình 5.20
Hình 5.21
Hình 5.22
Hình 5.23
Hình 5.24
Hình 5.25

Interaction cho tổng chi phí – spEA
Chu tuyến ParetoPopSize*Pc – spEA
Chu tuyến PopSize*Pm – spEA
Chu tuyến Pc*Pm – spEA
Chu tuyến Tournament*Pm – spEA
Kết quả chạy với GA
Minh họa kết quả chạy với Lekin – luật SPT
ðồ thị so sánh độ hữu ích (utilization)
So sánh GA và Lekin
Tổng chi phí của các phương pháp
Cải thiện tổng chi phí
ðộ hữu ích của các phương pháp
Bảng điều độ tuần 28 – Thực tế
Bảng ñiều ñộ tuần 28 – chương trình spEA
Bảng điều độ tuần 28 – chương trình i-awGA

Trang 4

65
66
66
66
67
69
69
70
71
72
73

73
74
75
76


DANH SÁCH BẢNG BIỂU
Tên Bảng Biều
Chương 2
Bảng 2.1
Bảng 2.2
Bảng 2.3
Chương 3
Bảng 3.1
Bảng 3.2
Bảng 3.3
Bảng 3.4
Bảng 3.5
Bảng 3.6
Chương 4
Bảng 4.1
Chương 5
Bảng 5.1
Bảng 5.2
Bảng 5.3
Bảng 5.4
Bảng 5.5
Bảng 5.6
Bảng 5.7
Bảng 5.8

Bảng 5.9
Bảng 5.10
Bảng 5.11
Bảng 5.12
Bảng 5.13
Bảng 5.14
Bảng 5.15
Bảng 5.16
Bảng 5.17
Bảng 5.18

Trang

Tóm tắt các luật cơ bản.
Bảng ma trận ñược-mất (payoff table)
Thành lập các biểu thức mục tiêu

13
19
20

ðịnh mức khuấy trộn Mixer A
Công suất khuấy trộn
Ma trận chuyển ñổi sản phẩm.
Bảng tốc ñộ chuẩn đóng chai và thời gian chuyển đổi.
Cơng suất đóng gói.
Ma trận chi phí chuyển đổi sản phẩm

32
32

33
34
35
35

Số thế hệ tối ña

46

Bảng thông số ñầu vào cho thiết kế thực nghiệm iAW
Số liệu ñầu vào cho thiết kế thực nghiệm cho chương trình iAW
Kết quả phân tích chi phí 2k cho iAW
Thơng số cho chương trình iAW
Bảng thơng số đầu vào cho thiết kế thực nghiệm AW
Số liệu ñầu vào cho thiết kế thực nghiệm cho chương trình AW
Kết quả phân tích DOE cho chương trìnhAW
Thơng số cho chương trình AW
Số liệu ñầu vào cho thiết kế thực nghiệm cho chương trình SP
Số liệu đầu vào cho thiết kế thực nghiệm cho chương trình SPEA
Kết quả phân tích DOE cho chương trình SPEA
Thơng số cho chương trình SPEA
Bảng cơng việc để so sánh GA với Lekin
So sánh thuật toán GA với các thuật tốn heuristic trong chương
trình Lekin
Bảng so sánh kết quả điều độ của các phương pháp
Tổng chi phí cải thiện
Bảng ñiều ñộ kế hoạch sản xuất tuần 28 – chương trình spEA
Bảng điều độ kế hoạch sản xuất tuần 28 – chương trình i-awGA

53

54
55
58
58
59
60
62
62
63
64
67
68
70

Trang 5

71
72
75
76


CHƯƠNG 1 GIỚI THIỆU
1.1 ðặt vấn ñề
Thị trường mỹ phẩm cạnh tranh khốc liệt, việc ñáp ứng hàng ñúng thời
ñiểm là rất quan trọng: liên quan ñến các vấn ñề Marketing quảng cáo, tung
chương trình khuyến mãi, tung sản phẩm mới trước đối thủ có nghĩa sống cịn.
Nhu cầu bán hàng lớn, chậm trễ trong việc giao hàng sẽ gây giảm doanh thu,
tăng các chi phí lưu kho, chi phí phạt do trễ đơn hàng, chi phí vận chuyển.
Ngồi thi trường trong nước, cơng ty cịn xuất khẩu đi một số nước trong khu

vực. Phấn ñấu trở thành nhà cung cấp hàng đầu trong nước và là quốc gia gia
cơng hàng trong khu vực.
Năng lực sản xuất của nhà máy khoảng 25 ngàn tấn / năm không vượt
quá nhiều nhu cầu sản phẩm, nhu cầu sản phẩm chăm sóc tóc năm 2008 dự
đốn 18,700 tấn, năm 2009 khoảng 20,000 tấn, do đó nếu kế hoạch điều độ sản
xuất khơng hợp lý sẽ khơng đáp ứng được sản lượng u cầu.
Chuyển ñổi sản phẩm thường xuyên gây tổn thất sản phẩm và tài ngun
(điện, nước để có nước nóng xúc rửa cho hệ thống khuấy trộn và đóng gói),
mất thời gian chuyển đổi. Tổn thất là khác nhau đối với trình tự sản xuất sản
phẩm khác nhau: từ màu ñậm qua màu nhạt sẽ mất nhiều thời gian hơn từ màu
nhạt sang đậm, hoặc từ sản phẩm bình dân sang cao cấp sẽ tốn thời gian hơn
việc chuyển từ cao cấp sang bình dân…
Việc thực hiện việc điều độ kế hoạch sản xuất của xưởng hiện tại chỉ dựa
vào kinh nghiệm do một giám sát sản xuất thực hiện và mất thời gian khoảng 1
– 1.5 ngày ñể thực hiện việc lên kế hoạch ñiều ñộ. Chất lượng của bảng ñiều ñộ
phụ thuộc vào kinh nghiệm, các giám sát sản xuất tại cơng ty có kiến thức
chun mơn về kỹ thuật, khơng có chun mơn về điều độ kế hoạch sản xuất
và sẽ là rất khó khăn cho xưởng sản xuất nếu vì lý do nào đó người đang phụ
trách việc ñiều ñộ không thể tiếp tục công việc. ðể thực hiện cơng việc điều độ
ở mức độ chấp nhận được, thời gian cần thiết ñể huấn luyện cho người mới là
khoảng 1 đến 2 tháng. Mà khi có trục trặc trong việc lên kế hoạch sản xuất sẽ
ảnh hướng tới kế hoạch ñiều ñộ nhân sự của xưởng, kế hoạch sản xuất bao bì
của các nhà cung cấp.
Với thực trạng là chưa có cơng cụ hỗ trợ hiệu quả của cơng việc điều độ
của xưởng để kế hoạch sản xuất hiệu quả hơn, vừa ñáp ứng ñược nhu cầu ñặt
hàng vừa cực tiểu chi phí chuyển đổi sản phẩm và ít tốn thời gian điều độ. Cần
thiết có nghiên cứu khoa học về vấn ñề ñiều ñộ kế hoạch sản xuất với các yêu
cầu thực tế như trên.
Trang 6

1.2 Mục tiêu luận văn
Nghiên cứu xây dựng hệ thống ñiều ñộ kế hoạch sản xuất cho nhà máy
với các mục tiêu :
+ Cực tiểu tổng thời gian trễ.
+ Cực tiểu số cơng việc trễ.
+ Cực tiểu chi phí khởi động.
Xây dựng phần mềm phù hợp với mơ hình sản xuất của cơng ty để thực
hiện việc điều độ. ðánh giá hiệu quả của kết quả chương trình.
1.3 Phạm vi và giới hạn
Phạm vi nghiên cứu trong nhà máy Unilever Việt Nam, xưởng sản phẩm lỏng,
phân xưởng sản phẩm chăm sóc tóc trên hệ thống các dây chuyền đóng chai,
đóng gói song song.
Khơng xem xét tới các xác suất xảy ra sự cố dừng máy, dừng dây chuyền trong
tuần. Không xem xét tới các chi phí tăng ca do khơng ñủ nhân la offspring, chua cac ca the
con
'******************
Dim A, B, C As Integer
Dim temPop As POPULATION
Dim i, j, k, g As Integer
Dim buffPop() As POPULATION
Dim tempPop As POPULATION
Dim numPareto, buffSize As Integer
Dim tempParetoPop() As
POPULATION
'********
' new factor
Dim alpha As Double
alpha = 1 / ParetoPopSize
Dim buffPopIndex As Integer

Dim Having As Boolean
'*************
If firstGen = True Then
buffSize = 2 * PopSize
Else
buffSize = PopSize + ParetoPopSize
End If
ReDim buffPop(buffSize)
ReDim tempParetoPop(buffSize)

Trang 12


ReDim
tempPop.chrom(chromLength)
ReDim
tempPop.joblate(chromLength)
For i = 1 To buffSize
ReDim
tempParetoPop(i).chrom(chromLength)
ReDim
tempParetoPop(i).joblate(chromLength)
ReDim
buffPop(i).chrom(chromLength)
ReDim
buffPop(i).joblate(chromLength)
Next
' ******
' dung buffPop de chua ca ca the tu
newpop va ParetoPop

' neu la lan dau tien thi copy tu pop va
newpop
' neu tu lan thu 2 tro di thi copy tu
ParetoPop va newpop
'****
If firstGen = True Then
For i = 1 To PopSize
buffPop(i) = pop(i)
buffPop(i + PopSize) = popNew(i)
buffPop(i).s = 0
buffPop(i + PopSize).s = 0
buffPop(i).r = 0
buffPop(i + PopSize).r = 0
Next
Else
buffSize = PopSize + ParetoPopSize
' For i = 1 To ParetoPopSize
'
ReDim
buffPop(i).chrom(chromLength)
'
ReDim
buffPop(i).joblate(chromLength)
' Next
' copy tu newpop va ParetoPop vao
buffPop
For i = 1 To PopSize
buffPop(i) = popNew(i)

buffPop(i).s = 0

buffPop(i).r = 0
Next
For i = 1 To ParetoPopSize
buffPop(i + PopSize) =
ParetoPop(i)
buffPop(i).s = 0
buffPop(i).r = 0
Next
End If ' fistGen
'**********
' Ket thuc phan copy cac ca the vao
buffpop
' tim cac phan tu khong bi troi
Dim domSet, domNum, domTard As
Double
' Dim ParetoList(PopSize) As Integer
Dim paretoIndex As Integer
paretoIndex = 0
' tim strenght chua cac ca the
For i = 1 To buffSize - 1
For j = i + 1 To buffSize
domSet = buffPop(i).SetupCost buffPop(j).SetupCost
domNum =
buffPop(i).NumTardObj buffPop(j).NumTardObj
domTard =
buffPop(i).TotalTardiness buffPop(j).TotalTardiness
' so sanh ca nhan giua i va j xem
phan tu nao troi hon
' neu i troi hon j, tang s cua i len
1

If (domSet < 0) And (domNum <
0) And (domTard < 0) Then
buffPop(i).s = buffPop(i).s + 1
End If

Trang 13


' neu j troi hon i, tang s cua j len
1
If (domSet > 0) And (domNum >
0) And (domTard > 0) Then
buffPop(j).s = buffPop(j).s + 1
End If

Next 'j

'*****
' neu bi troi ve so cong viec tre,
thi se bi cong them 1 he so
' khong phai la pareto
' If domSet > 0 Then
' buffPop(i).r = alpha +
buffPop(i).r
' Else
' buffPop(j).r = alpha +
buffPop(j).r
' End If

Next ' i

' ket thuc xac dinh strenght

Next 'j
Next ' i

' xac dinh gia tri r
For i = 1 To buffSize - 1
For j = i + 1 To buffSize

domSet = buffPop(i).SetupCost buffPop(j).SetupCost
domNum =
buffPop(i).NumTardObj buffPop(j).NumTardObj
domTard =
buffPop(i).TotalTardiness buffPop(j).TotalTardiness
' so sanh ca nhan giua i va j xem
phan tu nao troi hon
' neu i bi j troi, thi tang gia tri r
cua i len s strenght cua j
If domSet > 0 And domNum > 0
And domTard > 0 Then
buffPop(i).r = buffPop(i).r +
buffPop(j).s
End If
' neu j bi i troi, tang r cua j len s
cua i
If domSet < 0 And domNum < 0
And domTard < 0 Then
buffPop(j).r = buffPop(j).r +
buffPop(i).s
End If

' ket thuc tinh r
'' phan tu nao co r = 0, thi phan tu do
la phan tu thuoc pareto
' sap xep cac phan tu trong buffPop
theo thu tu giam dan cua r
For i = 1 To buffSize - 1
For j = i + 1 To buffSize
If buffPop(i).r > buffPop(j).r
Then
tempPop = buffPop(i)
buffPop(i) = buffPop(j)
buffPop(j) = tempPop
End If
Next ' j
Next ' i
' tinh khoang cach tu ca the toi cac ca
the khac, tinh fitness
' tinh thong tin mat do d
k = CInt(Sqr(buffSize))
Dim distanceList() As Double
ReDim distanceList(buffSize)
Dim temp As Double
Dim x, y As Integer
For i = 1 To buffSize

Trang 14


' tinh khoang cach tu ca the i toi cac ca

the khac trong buffpop
' neu i=j thi set la -1
For j = 1 To buffSize
If i = j Then
distanceList(i) = -1
Else
distanceList(j) =
Sqr((buffPop(i).SetupCost buffPop(j).SetupCost) ^ 2 +
(buffPop(i).TotalTardiness buffPop(j).TotalTardiness) ^ 2 +
(buffPop(i).NumTardObj buffPop(j).NumTardObj) ^ 2)
End If
Next ' j
'sap sep the thu tu giam dan
For x = 1 To buffSize - 1
For y = x + 1 To buffSize
If distanceList(x) > distanceList(y)
Then
temp = distanceList(x)
distanceList(x) = distanceList(y)
distanceList(y) = temp
End If
Next
Next
' gan khoang cach o thu tu k+1 cho ca
the i, k+1 vi co gia tri -1 la chinh no
buffPop(i).d = distanceList(k + 1)
Next ' i
' tinh xong khoang cach/thong tin mat
do tu ca the den cac ca the khac
'*********

' tinh fitness cho ca the
For i = 1 To buffSize
buffPop(i).f = buffPop(i).r + 1 /
(buffPop(i).d + 2)
Next

If buffPop(i).f > buffPop(j).f
Then
tempPop = buffPop(i)
buffPop(i) = buffPop(j)
buffPop(j) = tempPop
End If
Next ' j
Next ' i

' copy cac ca the khong bi troi vao
ParetoPop, trong ParetoPop co
numberinParetoPop members
paretoIndex = 0
buffPopIndex = 1
Do While buffPop(buffPopIndex).f <
1 And buffPopIndex < buffSize
' kiem tra xem no da co trong
tempParetoPop chua, neu co roi thi bo
qua
' neu chua co moi add vo
' tim buffPop(buffPopIndex) da co
trong tempParetoPop chua
Having = False
If paretoIndex > 0 Then

For g = 1 To paretoIndex
If buffPop(buffPopIndex).f =
tempParetoPop(g).f Then
Having =
Compare2Chrom(buffPop(buffPopIndex
), tempParetoPop(g))
If Having = True Then
Exit For
End If ' having
End If
Next
End If ' paretoindex

' sap xep buffPop theo thu tu tang dan
cua f, de tim non pareto solution
' chep vao tempParetoPop
For i = 1 To buffSize - 1
For j = i + 1 To buffSize

' neu khong co thi add vao
If Having = False Then
paretoIndex = paretoIndex + 1

Trang 15


' neu sau vong loop van tiep tuc
khong du
' tam add vao cac phan tu pareto cu
If i < ParetoPopSize Then

For g = i To ParetoPopSize
tempParetoPop(g) =
buffPop(ParetoPopSize - g + 1)
Next
End If

tempParetoPop(paretoIndex) =
buffPop(buffPopIndex)
End If
buffPopIndex = buffPopIndex + 1
Loop
' luc nay cac phan tu trong
tempParetoPop co the lon hon hoac nho
hon ParetoPopSize
' xu ly cac truong hop < hoac >
If paretoIndex < ParetoPopSize Then
' copy cac ca the tot tiep theo vao
ParetoPop

Else
If paretoIndex > ParetoPopSize
Then
' hien thi choi cho vui
' Me.TStatus.Value =
CInt(Me.TStatus.Value) + 1

i = paretoIndex + 1
' buffPopIndex = paretoIndex
Do While i <= ParetoPopSize And
buffPopIndex <= buffSize

' neu chua co moi add vo
buffPopIndex = buffPopIndex + 1
' tim buffPop(buffPopIndex) da co
trong tempParetoPop chua
Having = False
For g = paretoIndex To i
If buffPop(buffPopIndex).f =
tempParetoPop(g).f Then
Having =
Compare2Chrom(buffPop(buffPopIndex
), tempParetoPop(g))
If Having = True Then
Exit For
End If ' having
End If
Next
' neu khong co thi add vao
If Having = False Then
tempParetoPop(i) =
buffPop(buffPopIndex)
i=i+1
End If

' xoa cac ca the trong
tempParetoPop de bang voi
ParetoPopsize
' ky thuat TRUNCATION
OPERATOR
Do While paretoIndex >=
ParetoPopSize

' tim ca the co khoang cach nho
nhat den cac ca the khac trong
tempParetoPop de xoa
For i = 1 To paretoIndex
For j = 1 To paretoIndex
If i = j Then
distanceList(i) = -1
Else
distanceList(j) =
Sqr((tempParetoPop(i).SetupCost tempParetoPop(j).SetupCost) ^ 2 +
(tempParetoPop(i).TotalTardiness tempParetoPop(j).TotalTardiness) ^ 2 +
(tempParetoPop(i).NumTardObj tempParetoPop(j).NumTardObj) ^ 2)
End If
Next ' j
'tim khoang cach nho nhat
If distanceList(1) <> -1 Then

Loop

Trang 16


temp = distanceList(1)
Else
temp = distanceList(2)
End If

' the he moi, gan newpop vao pop de
tiep tuc the he sau
' For i = 1 To PopSize

'
pop(i) = popNew(i)
'
pop(i).r = 0
'
pop(i).d = 0
'
pop(i).s = 0
' Next

For k = 2 To paretoIndex
If distanceList(k) < temp And
distanceList(k) > -1 Then
temp = distanceList(k)
End If
Next ' k
tempParetoPop(i).d = temp
Next ' i

End Sub
Sub initialpop()

' sap xep ParetoPop theo thu tu
giam dan, sau do giam paretoIndex, ~
xoa ca the trong lop pareto co d nho nhat
For i = 1 To paretoIndex - 1
For j = 1 To paretoIndex
If tempParetoPop(i).d <
tempParetoPop(j).d Then
tempPop = tempParetoPop(i)

tempParetoPop(i) =
tempParetoPop(j)
tempParetoPop(j) = tempPop
End If
Next
Next

Dim CHROMOSOME() As Integer

paretoIndex = paretoIndex - 1
Loop 'paretoIndex >=
ParetoPopSize

' xac dinh so phan tram dao dong cua cac
may trong chromosome, tranh tinh trang
2 may qua gan nhau
dpercent = 0.8

Dim startPosition() As Integer
Dim dpercent As Double
Dim StandardChrom() As Byte
ReDim StandardChrom(NumberofJob)
ReDim startPosition(NumberofMachine)
ReDim Sched(NumberofMachine,
NumberofJob)
Dim i, j, k, l As Integer

End If
End If
' gan gia tri tu tempParetoPop vao

ParetoPop
For i = 1 To ParetoPopSize
ParetoPop(i) = tempParetoPop(i)
Next
' ket thuc ham initParetoPop se co
duoc ParetoPop voi ParetoPopsize ca the
khong bi troi

'ReDim BasicPop(PopSize)
For i = 1 To PopSize
ReDim pop(i).chrom(chromLength)
ReDim pop(i).joblate(chromLength)
ReDim popNew(i).chrom(chromLength)
ReDim popNew(i).joblate(chromLength)
'ReDim
BasicPop(i).chrom(chromLength)

Trang 17


StandardChrom(l) =
StandardChrom(l + 1)
Next
LengthLeft = LengthLeft - 1
Next
'CHROMOSOME(i,
startPosition(k) + 1) = 0
pop(i).chrom(startPosition(k) + 1)
= MACHINESIGN

'ReDim
BasicPop(i).joblate(chromLength)
Next
Dim GenIndex, LengthLeft As Integer

For i = 1 To PopSize - 2

Else
For j = startPosition(k - 1) + 2 To
startPosition(k)
'lay ngau nhien mot vi tri
GenIndex = Int(Rnd * LengthLeft
+ 1)
' gan job tai vi tri do vao
chromosome
'CHROMOSOME(i, j) =
standardChrom(GenIndex)
pop(i).chrom(j) =
StandardChrom(GenIndex)

LengthLeft = NumberofJob
MACHINESIGN = -1
'initial standardchrom
For l = 1 To NumberofJob
StandardChrom(l) = l
Next

' xac dinh vi tri may
If NumberofMachine > 1 Then
For k = 1 To NumberofMachine - 1

startPosition(k) = Int(NumberofJob
/ NumberofMachine) * k + Int((0.5 Rnd) * NumberofJob /
NumberofMachine * dpercent)
Next
startPosition(NumberofMachine) =
chromLength
For k = 1 To NumberofMachine
If k = 1 Then
For j = 1 To startPosition(k)
'lay ngau nhien mot vi tri
GenIndex = Int(Rnd * LengthLeft
+ 1)
' gan job tai vi tri do vao
chromosome
pop(i).chrom(j) =
StandardChrom(GenIndex)

' xoa job tren genindex sau khi
assign job do vao chromosome
For l = GenIndex To LengthLeft
-1

' xoa job tren genindex sau khi
assign job do vao chromosome
For l = GenIndex To LengthLeft
-1
StandardChrom(l) =
StandardChrom(l + 1)
Next
LengthLeft = LengthLeft - 1

Next
If (k < NumberofMachine) Then
'CHROMOSOME(i,
startPosition(k) + 1) = 0
pop(i).chrom(startPosition(k) +
1) = MACHINESIGN
End If
End If ' if k
MACHINESIGN = MACHINESIGN 1
Next
End If ' if machine

Trang 18


recPop.Fields("fitness").Value =
pop(j).fitness
recPop.Fields("TotalCost").Value =
pop(j).ToTalCost
recPop.Fields("SetupCostObj").Value
= pop(j).SetupCostObj
recPop.Fields("TotalTardObj").Value
= pop(j).TotalTardObj
recPop.Fields("NumTardObj").Value
= pop(j).NumTardObj

Next
'heuristic earliest due date first
pop(PopSize - 1) = EDD()
'heuristic Longest processing time first

pop(PopSize) = LPT()
'Call CodingChrom
Dim strSched As String

recPop.Fields("NumberOfTardiness").V
alue = pop(j).NumberOfTardiness
recPop.Fields("SetupCost").Value =
pop(j).SetupCost

For i = 1 To PopSize
Call FitnessCal(pop(i))
Next

' tinh Zpos and Zneg cua initial pop
'Call ZposZneg
'Call WeightedSumObj
'Call WeightedSumProb
'*****
' SPEA, tim cac phan tu khong bi troi,
cho vao ParetoPop
Call InitParetoPop

' mo table PopTable, luu lai cac buoc
Dim recPop As ADODB.Recordset
Set recPop = New ADODB.Recordset
'mo table PopTable de luu lai
recPop.Open "Select * From PopTable",
CurrentProject.Connection,
adOpenKeyset, adLockOptimistic
If recPop.EOF = False Then

recPop.MoveLast
End If
'luu vao bang
For j = 1 To PopSize
recPop.AddNew
recPop.Fields("generation").Value = 0
recPop.Fields("Chromno").Value = j

recPop.Fields("TotalTardiness").Value =
pop(j).TotalTardiness
recPop.Fields("Cmax").Value =
pop(j).Cmax
recPop.Fields("prob").Value =
pop(j).prob
recPop.Fields("z").Value = pop(j).z
recPop.Fields("p").Value = pop(j).p
recPop.Fields("r").Value = pop(j).r
recPop.Fields("s").Value = pop(j).s
recPop.Fields("d").Value = pop(j).d
recPop.Fields("f").Value = pop(j).f
recPop.Fields("ProdWeek").Value =
ProdWeek
recPop.Fields("chrom").Value =
toStringChrom(pop(j))
recPop.Fields("joblate").Value =
toStringJobLate(pop(j))
recPop.Update
Next
recPop.Close
End Sub

Sub FitnessCal(calPop As
POPULATION)
' tinh so cong viec tre, tong tre, trung
binh tre
Dim i, j As Integer

Trang 19


Dim NumberOfLateness() As Integer
Dim AverageOfLateness() As Double
Dim TotalOfLateness() As Double
Dim Cj() As Double
Dim JobOnMachine() As Integer
'Dim sched() As Integer
Dim SetupCost() As Double
Dim changeSizeTime,
changeBrandTime As Integer
ReDim
NumberOfLateness(NumberofMachine)
ReDim
AverageOfLateness(NumberofMachine)
ReDim
TotalOfLateness(NumberofMachine)
ReDim Cj(NumberofMachine)
ReDim
JobOnMachine(NumberofMachine)
'ReDim Sched(NumberofMachine,
NumberofJob)
ReDim SetupCost(NumberofMachine)

' thoi gian de chuyen doi size va Brand
changeSizeTime = 10
changeBrandTime = 40
' reset lai sched
For i = 1 To NumberofMachine
For j = 1 To NumberofJob
Sched(i, j) = 0
Next
Next ' i
' reset lai job
For i = 1 To NumberofJob
job(i).SetupCost = 0
job(i).TotalLateCost = 0
job(i).NumLateCost = 0
Next
' reset lai calPop , khi lai tao, phai tinh
lai cac thong so khac
For i = 1 To chromLength
calPop.joblate(i) = 0
Next
calPop.NumberOfTardiness = 0

calPop.TotalTardiness = 0
calPop.SetupCost = 0
calPop.NumTardObj = 0
calPop.TotalTardObj = 0
' decode the chromosome
Dim m, n As Integer
m=1
n=1

For i = 1 To NumberofMachine +
NumberofJob - 1
If calPop.chrom(i) > 0 Then
' neu chua gap so 0, chi bat dau may
moi
Sched(m, n) = calPop.chrom(i)
n=n+1
Else
' neu gap so 0, bat dau may moi, cong
viec tro lai 1
If calPop.chrom(i) <= -1 Then
m=m+1
n=1
End If
End If
Next
'set 0
For i = 1 To NumberofMachine
Cj(i) = 0
NumberOfLateness(i) = 0
TotalOfLateness(i) = 0
JobOnMachine(i) = 0
SetupCost(i) = 0
Next
'dem so cong viec tren moi may
For i = 1 To NumberofMachine
For j = 1 To NumberofJob
If Sched(i, j) > 0 Then
JobOnMachine(i) = JobOnMachine(i)
+1

' sheet1.Cells(100 + j, i) = sched(i, j)
End If

Trang 20


SetupCost(i) = SetupCost(i) +
job(Sched(i, j)).SetupCost

Next
Next

' thoi gian bat dau cong viec cua job
job(Sched(i, j)).startTime = Cj(i)

Dim LateIndex As Integer
Dim changeSize, changeBrand As
Double
LateIndex = 0
For i = 1 To NumberofMachine

'cap nhat Cj, sau khi lam
job(sched(i,j)
Cj(i) = Cj(i) + job(Sched(i, j)).Pj
' thoi gian bat dau cong viec cua job
job(Sched(i, j)).EndTime = Cj(i)

For j = 1 To JobOnMachine(i) '- 1 ' 1: do se xu ly cong viec cuoi cung sau
vong lap j
' gan may cho job

job(Sched(i, j)).machine = i
' tinh set up cost
If j < JobOnMachine(i) - 1 Then
If job(Sched(i, j)).BottleSize <>
job(Sched(i, j + 1)).BottleSize Then
changeSize = 1
Else
changeSize = 0
End If
If (job(Sched(i, j)).Brand <>
job(Sched(i, j + 1)).Brand) Or
(job(Sched(i, j)).Variant <> job(Sched(i,
j + 1)).Variant) Then
changeBrand = 1
Else
changeBrand = 0
End If
Else
changeSize = 1
changeBrand = 1
End If

job(Sched(i, j)).SetupCost =
changeSize *
ChangeOverCost(1).changeSize +
changeBrand *
(ChangeOverCost(1).water +
ChangeOverCost(1).product *
ProductStandardCost(job(Sched(i,
j)).productCode))

' tinh so cong viec tre va tong tre
sched(i, j) > 0 And
' neu tre
If job(Sched(i, j)).Dj < Cj(i) Then
LateIndex = LateIndex + 1
NumberOfLateness(i) =
NumberOfLateness(i) + 1
TotalOfLateness(i) =
TotalOfLateness(i) + Cj(i) - job(Sched(i,
j)).Dj
calPop.joblate(LateIndex) =
Sched(i, j)
' so cong viec tre giam theo gia tri
cua don hang tre và trong so
job(Sched(i, j)).NumLateCost =
ProductStandardCost(job(Sched(i,
j)).productCode) * job(Sched(i, j)).Planj
* job(Sched(i, j)).Wj / 10
calPop.NumTardObj =
calPop.NumTardObj + job(Sched(i,
j)).NumLateCost
job(Sched(i, j)).TotalLateCost =
0.02 * (Cj(i) - job(Sched(i, j)).Dj) / 1440
* ProductStandardCost(job(Sched(i,
j)).productCode) * job(Sched(i, j)).Planj
' tinh chi phi tong tre, neu tre gia tri
phat + chi phi 2%/ngay 1440 phut tren
gia tri lo hang
calPop.TotalTardObj =

calPop.TotalTardObj + job(Sched(i,
j)).TotalLateCost
End If

Trang 21


' startime cua cong viec ke, cong
them thoi gian chuyen doi size va brand
If j < JobOnMachine(i) Then
Cj(i) = Cj(i) + changeBrand *
changeBrandTime + changeSize *
changeSizeTime
End If

calPop.SetupCostObj =
calPop.SetupCost '* CostSetup
'chi phi tre
'calPop.TotalTardObj =
calPop.TotalTardiness * CostTotalTard
'calPop.NumTardObj =
calPop.NumberOfTardiness *
CostNumTard

Next ' j, ket thuc cac cong viec tren
may i

calPop.ToTalCost =
calPop.SetupCostObj +
calPop.TotalTardObj +

calPop.NumTardObj

Next i

Dim tempCmax As Double
tempCmax = Cj(1)

For i = 1 To NumberofMachine
calPop.NumberOfTardiness =
calPop.NumberOfTardiness +
NumberOfLateness(i)
calPop.TotalTardiness =
calPop.TotalTardiness +
TotalOfLateness(i)
calPop.SetupCost = calPop.SetupCost
+ SetupCost(i)
If tempCmax < Cj(i) Then
tempCmax = Cj(i)
End If
Next
calPop.Cmax = tempCmax

Call CalObjective(calPop)

End Sub
Private Sub CalObjective(calPop As
POPULATION)
' chi phi setup

'fitness se tinh 1- ti so giua totalcost

va gia tri lo hang
calPop.fitness = 1 - calPop.ToTalCost
/ VALUEOFSCHEDULE
End Sub
Private Sub MatingSelection()
Dim i, j, k, findParent As Integer
Dim SumOfFit As Double
Dim SumOfProb As Double
Dim r As Double
Dim NewPopNum As Integer
Dim popParent() As POPULATION
Dim popChildren() As POPULATION
Dim tour1, tour2 As Integer
Dim popTour1 As POPULATION
Dim popTour2 As POPULATION
Dim temp, tempProb As Double
SumOfFit = 0
SumOfProb = 0
NewPopNum = 0
r=0
findParent = 1
ReDim popParent(2)
ReDim popChildren(2)
ReDim popTour1.chrom(chromLength)
ReDim popTour1.joblate(chromLength)

Trang 22


Next

ReDim popTour2.chrom(chromLength)
ReDim popTour2.joblate(chromLength)

NewPopNum = NewPopNum + 2
End If ' end married

For i = 1 To 2
ReDim
popParent(i).chrom(chromLength)
ReDim
popChildren(i).chrom(chromlenght)
ReDim
popParent(i).joblate(chromLength)
ReDim
popChildren(i).joblate(chromLength)
Next

Loop While NewPopNum < PopSize

Do

'1. chon 1 cap cha me trong pop
'2. lai tao
'3. cho vao newpop

' chon cha me bang binary tournament
selection
For j = 1 To 2
'***********

'tournament selection
popParent(j) = TournamentSelection()
'*********
Next
' het chon binary tournament selection

' ParentFollow = ParentFollow + 1
End Sub
Private Sub CrossOver(mum As
POPULATION, dad As POPULATION,
child1 As POPULATION, child2 As
POPULATION, married As Boolean)
Dim CrossPos1, CrossPos2 As Integer
Dim i, j As Integer
Dim y As Integer
Dim StandardChrom() As Integer
Dim GenSurplus(), SurplusPos() As
Integer
Dim GenLack() As Integer
Dim present As Boolean
Dim NoOfLack As Integer
Dim child() As POPULATION
Dim Pcrossover As Double
Pcrossover = Rnd
ReDim GenSurplus(chromLength)
ReDim SurplusPos(chromLength)
ReDim GenLack(chromLength)
ReDim child(2)
For i = 1 To 2
ReDim child(i).chrom(chromLength)

ReDim child(i).joblate(chromLength)
Next

'lai tao
Dim married As Boolean
'neu marrid = true: co lai tao, false
khong lai tao
Call CrossOver(popParent(1),
popParent(2), popChildren(1),
popChildren(2), married)
If married = True Then
For k = 1 To 2
Call FitnessCal(popChildren(k))
popNew(NewPopNum + k) =
popChildren(k)

ReDim
StandardChrom(chromLength)

married = False

Trang 23


' neu Pcrossover < Pc xac suat lai, thi
tien hanh lai, neu khong thi giu nguyen
cap cha me
If Pcrossover < Pc Then
married = True
'gan gia tri cho standardchrom, tinh ca

may -1, -2...
For i = 1 To NumberofJob
StandardChrom(i) = i
Next
For i = NumberofJob + 1 To
NumberofJob + NumberofMachine - 1
StandardChrom(i) = NumberofJob - i
Next
CrossPos1 = 1 + Int(Rnd *
chromLength)
CrossPos2 = 1 + Int(Rnd *
chromLength)
If CrossPos1 > CrossPos2 Then
i = CrossPos1
CrossPos1 = CrossPos2
CrossPos2 = i
End If

child(1) = mum
child(2) = dad

For i = 1 To chromLength - 1
For j = i + 1 To chromLength
If child(index).chrom(i) =
child(index).chrom(j) Then
k=k+1
GenSurplus(k) =
child(index).chrom(i)
SurplusPos(k) = j

End If
Next
Next
' xac dinh gen thieu
NoOfLack = 0
For i = 1 To chromLength
present = False
For j = 1 To chromLength
If StandardChrom(i) =
child(index).chrom(j) Then
present = True
End If
Next
If present = False Then
NoOfLack = NoOfLack + 1
GenLack(NoOfLack) =
StandardChrom(i)
End If
Next

' theo doi so lan lai tao
' NumOfCross = NumOfCross + 1
'hoan doi vi tri gen giua cha va me
For y = CrossPos1 To CrossPos2
child(1).chrom(y) = dad.chrom(y)
child(2).chrom(y) = mum.chrom(y)
Next

' xoa gen thua, bo xung gen thieu
For i = 1 To NoOfLack

child(index).chrom(SurplusPos(i)) =
GenLack(i)
Next
Call Mutation(child(index))

' loai bo gen thua, them vao gen thieu
cho child1 va child2
Dim index As Integer
For index = 1 To 2
k=0
' xac dinh gen thua va vi tri thua

' tinh lai gia tri fitness
Call FitnessCal(child(index))

Trang 24


Next ' end index
End If ' if Pcrossover< pc
child1 = child(1)
child2 = child(2)

End Sub

Sub Mutation(mutateChrom As
POPULATION)
Dim temp As Integer
Dim Pos1, Pos2 As Integer
Dim probMutation As Double

probMutation = Rnd
'neu roi vao khoan Pm thi tien hanh dot
bien
If probMutation < Pm Then
Pos1 = 1 + Int(Rnd * chromLength)
Pos2 = 1 + Int(Rnd * chromLength)
temp = mutateChrom.chrom(Pos1)
mutateChrom.chrom(Pos1) =
mutateChrom.chrom(Pos2)
mutateChrom.chrom(Pos2) = temp
' theo doi so lan dot bien
' NumOfMutation = NumOfMutation
+1
End If
End Sub
Function Compare2Chrom(chr1 As
POPULATION, chr2 As
POPULATION) As Boolean

Dim m, Diff As Integer
Diff = 0
For m = 1 To chromLength

Diff = Diff + Abs(chr1.chrom(m)
- chr2.chrom(m))
Next
If Diff = 0 Then
Compare2Chrom = True
Else
Compare2Chrom = False

End If
End Function
Function toStringChrom(chrom As
POPULATION) As String
Dim i, j As Integer
Dim strSchedule As String
strSched = ""
For j = 1 To chromLength
If chrom.chrom(j) < 0 Then
strSched = strSched + "* "
Else
strSched = strSched +
CStr(chrom.chrom(j)) + " "
End If
Next
toStringChrom = strSched
End Function
Function toStringJobLate(chrom As
POPULATION) As String
Dim i As Integer
Dim str As String
str = ""
For i = 1 To
chrom.NumberOfTardiness
str = str + CStr(chrom.joblate(i))
+""
Next
toStringJobLate = str
End Function
Function EDD() As POPULATION

' schedule as EDD earliest due date first
' sap sep theo thu tu giam dan cua Dj
Dim Cj() As Double

Trang 25


Dim i, j As Integer
Dim temp As JOBMODULE

For j = 1 To NumberofJob
'tim may co Cj nho nhat
minCjmachine = 1
For i = 1 To NumberofMachine

ReDim Cj(NumberofMachine)
ReDim
machineIndex(NumberofMachine)

If Cj(minCjmachine) > Cj(i) Then
minCjmachine = i
End If

Dim tempJob() As JOBMODULE
ReDim tempJob(NumberofJob)
For i = 1 To NumberofJob
tempJob(i) = job(i)
Next

For i = 1 To NumberofJob

For j = i + 1 To NumberofJob
If (tempJob(i).Dj > tempJob(j).Dj)
Then
' due date
temp = tempJob(i)
tempJob(i) = tempJob(j)
tempJob(j) = temp
End If
Next
Next

Next
'gan job cho machine
Sched(minCjmachine,
machineIndex(minCjmachine)) =
tempJob(j).JobIndex
Cj(minCjmachine) =
Cj(minCjmachine) + tempJob(j).Pj
machineIndex(minCjmachine) =
machineIndex(minCjmachine) + 1

Next
'giam machine index lai 1 don vi de vua
dung voi so cong viec trong may
For i = 1 To NumberofMachine
machineIndex(i) = machineIndex(i) 1
Next
EDD = CodingChrom()

'reset to 0

For i = 1 To NumberofMachine
machineIndex(i) = 1
Cj(i) = 0
For j = 1 To NumberofJob
Sched(i, j) = 0
Next
Next

End Function
Function LPT() As POPULATION
' Longest processing time

Dim k As Integer

ReDim Cj(NumberofMachine)
ReDim
machineIndex(NumberofMachine)

' dieu do theo EDD

' sap xep theo thu tu giam dan cua Pj
Dim i, j As Integer
Dim temp As JOBMODULE
Dim Cj() As Double
'Dim machineIndex() As Integer

Trang 26