1. Trang chủ
  2. » Luận Văn - Báo Cáo

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

162 32 0

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 162
Dung lượng 3,4 MB

Nội dung

ðạ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 HOÀ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 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ị chữ ký) Cán chấm nhận xét : (Ghi rõ họ, tên, học hàm, học vị chữ ký) Cán chấm nhận xét : (Ghi rõ họ, tên, học hàm, học vị chữ ký) Luận văn Thạc sĩ ñược bảo vệ 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 thực trạng điều độ cơng ty - Tìm hiểu giải thuật GA, ứng dụng GA ñiều ñộ ñiều ñộ ña mục tiêu - So sánh ñánh giá ưu khuyết ñiểm giải thuật GA - Ứng dụng GA vào việc giả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 chữ ký) Tiến Sĩ NGUYỄN TUẤN ANH Nội dung ñề cương luận văn thạc sĩ ñã ñược hội ñồng chuyên 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 thực luận văn Xin chân thành biết ơn thầy cô môn Kỹ Thuật Hệ Thống Cơng Nghiệp hướng dẫn, cung cấp kiến thức thời gian học tập trường truyền lịng đam mê nghiên cứu khoa học cho tơi Các bạn lớp cao học ISE20006, có tập thể tuyệt vời, hỗ trợ lúc học tập, nghiên cứu 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 chị Hịa nhiệt tình hỗ trợ tơi tìm hiểu hệ thống sản xuất lập kế hoạch nhà máy Cám ơn ba mẹ động viên khuyến khích gia đình chia xẻ gánh nặng sống để tơi có điều kiện hồn thành chương trình học trường thực luận văn MỤC LỤC Trang Tổng quan 1.1 ðặt vấn ñề 1.2 Mục tiêu luận văn 1.3 Phạm vi giới hạn 1.4 Bố cục luận văn Cơ sở lý thuyết 2.1 Lý thuyết ñiều ñộ sản xuất 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 q trình ràng buộc 2.1.1.4 Các mục tiêu ñ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 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 toán 2.2.1.2 Các lời giải tối ưu hiệu 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 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) Khảo thực tế 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 6 7 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 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 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 i-awGA 4.5.4 Theo thuật toán spEA (Strength Pareto Evolutionary Algorithm) 4.5.5 Tính độ hữu ích (utilization) 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 sở liệu 4.7.2 Sơ đồ khối chương trình 4.7.3 Hoạt động chương trình Thiết kế thực nghiệm đánh giá hiệu chương trình 5.1 Thiết kế thực nghiệm tìm 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 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ế so sánh chương trình với 5.2.3 Kết luận Kết luận hướng phát triển ñề tài 6.1 Kết luận 6.2 ðiểm hạn chế hướng phát triển ñề 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 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 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 Hình 3.1 Hình 3.2 Chương 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 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 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 Một trường hợp không tồn vùng lời giải khả thi Minh họa tính sức mạnh độ phù hợp với tốn maximum mục tiêu So sánh chế tính độ phù hợp spEA spEA2 Minh họa toán tử truncation với N’ = Minh họa giá trị ñộ phù hợp chế gán ñộ phù hợp khác 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 thiếu Phương pháp ñột biến Lưu ñồ chương trình theo awGA i-awGA Chiến lược Elitist Lưu đồ chương trình theo spEA Số hệ tối đa maxGen chương trình Bảng lưu cơng việc cần ñiều ñộ Bảng kết ñiều ñộ Bảng lưu giá thành sản phẩm, tính chi phí khởi động giá trị đơn hàng Bảng lưu chi phí khởi động Bảng lưu 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ơ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 Pm– i-awGA Chu tuyến A Pm– i-awGA Chu tuyến A Pc– i-awGA Main Effect cho tổng chi phí-awGA Interaction cho tổng chi phí-awGA Chu tuyến PopSize Pm-awGA Chu tuyến PopSize A-awGA Main Effect cho tổng chi phí - spEA 56 56 57 57 57 60 61 61 62 65 Trang 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 chạy với GA Minh họa kết chạy với Lekin – luật SPT ðồ thị so sánh độ hữu ích (utilization) So sánh GA Lekin Tổng chi phí phương pháp Cải thiện tổng chi phí ðộ hữu ích 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 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 Bảng 2.1 Bảng 2.2 Bảng 2.3 Chương 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 Bảng 4.1 Chương 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 luật Bảng ma trận ñược-mất (payoff table) Thành lập 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 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ố 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 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 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 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 tốn GA với thuật tốn heuristic chương trình Lekin Bảng so sánh kết ñiều ñộ 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 71 72 75 76 CHƯƠNG 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 quan trọng: liên quan ñến vấn ñề Marketing quảng cáo, tung chương trình khuyến mãi, tung sản phẩm trước đối thủ có nghĩa sống cịn Nhu cầu bán hàng lớn, chậm trễ việc giao hàng gây giảm doanh thu, tăng chi phí lưu kho, chi phí phạt trễ đơn hàng, chi phí vận chuyển Ngồi thi trường nước, cơng ty cịn xuất số nước khu vực Phấn ñấu trở thành nhà cung cấp hàng ñầu nước quốc gia gia công hàng khu vực Năng lực sản xuất nhà máy khoảng 25 ngàn / năm không vượt 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, kế hoạch ñiều ñộ sản xuất không hợp lý không ñáp ứng ñược sản lượng yêu cầu Chuyển ñổi sản phẩm thường xuyên gây tổn thất sản phẩm tài nguyên (điện, nước để có nước nóng xúc rửa cho hệ thống khuấy trộn đóng gói), thời gian chuyển ñổi Tổn thất khác ñố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 nhiều thời gian từ màu nhạt sang đậm, từ sản phẩm bình dân sang cao cấp tốn thời gian việc chuyển từ cao cấp sang bình dân… Việc thực việc điều ñộ kế hoạch sản xuất xưởng dựa vào kinh nghiệm giám sát sản xuất thực thời gian khoảng – 1.5 ngày ñể thực việc lên kế hoạch ñiều ñộ Chất lượng bảng ñiều ñộ phụ thuộc vào kinh nghiệm, giám sát sản xuất cơng ty có kiến thức chun mơn kỹ thuật, khơng có chun mơn điều độ kế hoạch sản xuất khó khăn cho xưởng sản xuất lý người phụ trách việc điều ñộ tiếp tục công việc ðể thực 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 khoảng đến tháng Mà có trục trặc việc lên kế hoạch sản xuất ảnh hướng tới kế hoạch ñiều ñộ nhân xưởng, kế hoạch sản xuất bao bì nhà cung cấp Với thực trạng chưa có cơng cụ hỗ trợ hiệu cơng việc điều độ xưởng ñể kế hoạch sản xuất hiệu 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 tốn thời gian ñiều ñộ Cần thiết có nghiên cứu khoa học vấn ñề ñiều ñộ kế hoạch sản xuất với yêu cầu thực tế Trang temp = distanceList(1) Else temp = distanceList(2) End If ' the he moi, gan newpop vao pop de tiep tuc the he sau ' For i = To PopSize ' pop(i) = popNew(i) ' pop(i).r = ' pop(i).d = ' pop(i).s = ' Next For k = 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 giam paretoIndex, ~ xoa ca the lop pareto co d nho nhat For i = To paretoIndex - For j = 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 - Loop 'paretoIndex >= ParetoPopSize ' xac dinh so phan tram dao dong cua cac may chromosome, tranh tinh trang may qua gan 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 = 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 = 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 - Next 'CHROMOSOME(i, startPosition(k) + 1) = pop(i).chrom(startPosition(k) + 1) = MACHINESIGN 'ReDim BasicPop(i).joblate(chromLength) Next Dim GenIndex, LengthLeft As Integer For i = To PopSize - Else For j = startPosition(k - 1) + To startPosition(k) 'lay ngau nhien mot vi tri GenIndex = Int(Rnd * LengthLeft + 1) ' gan job tai vi tri vao chromosome 'CHROMOSOME(i, j) = standardChrom(GenIndex) pop(i).chrom(j) = StandardChrom(GenIndex) LengthLeft = NumberofJob MACHINESIGN = -1 'initial standardchrom For l = To NumberofJob StandardChrom(l) = l Next ' xac dinh vi tri may If NumberofMachine > Then For k = To NumberofMachine - startPosition(k) = Int(NumberofJob / NumberofMachine) * k + Int((0.5 Rnd) * NumberofJob / NumberofMachine * dpercent) Next startPosition(NumberofMachine) = chromLength For k = To NumberofMachine If k = Then For j = To startPosition(k) 'lay ngau nhien mot vi tri GenIndex = Int(Rnd * LengthLeft + 1) ' gan job tai vi tri vao chromosome pop(i).chrom(j) = StandardChrom(GenIndex) ' xoa job tren genindex sau assign job vao chromosome For l = GenIndex To LengthLeft -1 ' xoa job tren genindex sau assign job vao chromosome For l = GenIndex To LengthLeft -1 StandardChrom(l) = StandardChrom(l + 1) Next LengthLeft = LengthLeft - Next If (k < NumberofMachine) Then 'CHROMOSOME(i, startPosition(k) + 1) = pop(i).chrom(startPosition(k) + 1) = MACHINESIGN End If End If ' if k MACHINESIGN = MACHINESIGN 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 = 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 = To PopSize recPop.AddNew recPop.Fields("generation").Value = 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 = To NumberofMachine For j = To NumberofJob Sched(i, j) = Next Next ' i ' reset lai job For i = To NumberofJob job(i).SetupCost = job(i).TotalLateCost = job(i).NumLateCost = Next ' reset lai calPop , lai tao, phai tinh lai cac thong so khac For i = To chromLength calPop.joblate(i) = Next calPop.NumberOfTardiness = calPop.TotalTardiness = calPop.SetupCost = calPop.NumTardObj = calPop.TotalTardObj = ' decode the chromosome Dim m, n As Integer m=1 n=1 For i = To NumberofMachine + NumberofJob - If calPop.chrom(i) > 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 If calPop.chrom(i) 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 = For i = To NumberofMachine 'cap nhat Cj, sau 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 = To JobOnMachine(i) '- ' 1: 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) - Then If job(Sched(i, j)).BottleSize job(Sched(i, j + 1)).BottleSize Then changeSize = Else changeSize = 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 = Else changeBrand = End If Else changeSize = changeBrand = 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) > And ' neu tre If job(Sched(i, j)).Dj < Cj(i) Then LateIndex = LateIndex + NumberOfLateness(i) = NumberOfLateness(i) + 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 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 = 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 = - 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 = SumOfProb = NewPopNum = r=0 findParent = 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 + End If ' end married For i = To 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 cap cha me pop '2 lai tao '3 cho vao newpop ' chon cha me bang binary tournament selection For j = To '*********** 'tournament selection popParent(j) = TournamentSelection() '********* Next ' het chon binary tournament selection ' ParentFollow = ParentFollow + 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 = To 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 = To 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 = To NumberofJob StandardChrom(i) = i Next For i = NumberofJob + To NumberofJob + NumberofMachine - StandardChrom(i) = NumberofJob - i Next CrossPos1 = + Int(Rnd * chromLength) CrossPos2 = + Int(Rnd * chromLength) If CrossPos1 > CrossPos2 Then i = CrossPos1 CrossPos1 = CrossPos2 CrossPos2 = i End If child(1) = mum child(2) = dad For i = To chromLength - For j = i + 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 = For i = To chromLength present = False For j = To chromLength If StandardChrom(i) = child(index).chrom(j) Then present = True End If Next If present = False Then NoOfLack = NoOfLack + GenLack(NoOfLack) = StandardChrom(i) End If Next ' theo doi so lan lai tao ' NumOfCross = NumOfCross + '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 = 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 = To 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 = + Int(Rnd * chromLength) Pos2 = + 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 = For m = To chromLength Diff = Diff + Abs(chr1.chrom(m) - chr2.chrom(m)) Next If Diff = 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 = To chromLength If chrom.chrom(j) < 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 = 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 = To NumberofJob 'tim may co Cj nho nhat minCjmachine = For i = 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 = To NumberofJob tempJob(i) = job(i) Next For i = To NumberofJob For j = i + 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) + Next 'giam machine index lai don vi de vua dung voi so cong viec may For i = To NumberofMachine machineIndex(i) = machineIndex(i) Next EDD = CodingChrom() 'reset to For i = To NumberofMachine machineIndex(i) = Cj(i) = For j = To NumberofJob Sched(i, j) = Next Next End Function Function LPT() As POPULATION ' Longest processing time Dim k As Integer ReDim Cj(NumberofMachine) ReDim machineIndex(NumberofMachine) ' dieu 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 End If Dim tempJob() As JOBMODULE ReDim tempJob(NumberofJob) For i = To NumberofJob tempJob(i) = job(i) Next For j = To NumberofMachine Cj(j) = machineIndex(j) = Next For i = To NumberofJob For j = i + To NumberofJob If (tempJob(i).Pj < tempJob(j).Pj) Then ' process temp = tempJob(i) tempJob(i) = tempJob(j) tempJob(j) = temp End If Next 'gan job cho machine Sched(minCjmachine, machineIndex(minCjmachine)) = tempJob(j).JobIndex Cj(minCjmachine) = Cj(minCjmachine) + tempJob(j).Pj machineIndex(minCjmachine) = machineIndex(minCjmachine) + Next 'giam machine index lai don vi de vua dung voi so cong viec may For i = To NumberofMachine machineIndex(i) = machineIndex(i) Next LPT = CodingChrom() Next Next ' dieu theo LPF 'reset to For i = To NumberofMachine machineIndex(i) = Cj(i) = For j = To NumberofJob Sched(i, j) = Next Next For j = To NumberofJob 'tim may co Cj nho nhat minCjmachine = For i = To NumberofMachine If Cj(minCjmachine) > Cj(i) Then minCjmachine = i End Function Function CodingChrom() As POPULATION 'chromindex Dim tempPop As POPULATION Dim chromIndex, mcsign As Integer Dim i, j As Integer chromIndex = mcsign = -1 ReDim tempPop.chrom(chromLength) ReDim tempPop.joblate(chromLength) For i = To NumberofMachine For j = To machineIndex(i) tempPop.chrom(chromIndex) = Sched(i, j) Trang 27 chromIndex = chromIndex + Next ' machineIndex If recPop.EOF = False Then recPop.MoveFirst End If While recPop.EOF = False recPop.Delete recPop.Update recPop.MoveNext Wend recPop.Close If i < NumberofMachine Then tempPop.chrom(chromIndex) = mcsign mcsign = mcsign - chromIndex = chromIndex + End If Next ' chromlenght CodingChrom = tempPop End Function Private Sub CResetPopTable_Click() On Error GoTo Err_CResetPopTable_Click Exit_CResetPopTable_Click: Exit Sub ' mo table PopTable, luu lai cac buoc Dim recPop As ADODB.Recordset Set recPop = New ADODB.Recordset End Sub Sub InitParetoPop() Dim i, j, k As Integer Dim buffPop() As POPULATION Dim tempPop As POPULATION Dim numPareto, buffSize As Integer Err_CResetPopTable_Click: MsgBox Err.Description Resume Exit_CResetPopTable_Click 'mo table PopTable de luu lai recPop.Open "Select * From PopTable", CurrentProject.Connection, adOpenKeyset, adLockOptimistic If recPop.EOF = False Then recPop.MoveFirst End If While recPop.EOF = False recPop.Delete recPop.Update recPop.MoveNext Wend recPop.Close 'refresh lai bang 'Me.PopTable_subform.Requery 'Me.ParetoTable_subform.Requery 'mo table paretoTable de luu lai recPop.Open "Select * From paretoTable", CurrentProject.Connection, adOpenKeyset, adLockOptimistic buffSize = PopSize ' +ParetoPopSize ReDim buffPop(buffSize) ReDim tempPop.chrom(chromLength) ReDim tempPop.joblate(chromLength) For i = To buffSize ReDim buffPop(i).chrom(chromLength) ReDim buffPop(i).joblate(chromLength) Next ' copy tu pop va ParetoPop vao buffPop For i = To buffSize buffPop(i) = pop(i) buffPop(i).s = buffPop(i).r = Trang 28 Next ' xac dinh gia tri r For i = To buffSize - ' tim cac phan tu khong bi troi Dim domSet, domNum, domTard As Double ' Dim ParetoList(PopSize) As Integer Dim paretoIndex As Integer For j = i + To buffSize domSet = buffPop(i).SetupCost buffPop(j).SetupCost domNum = buffPop(i).NumTardObj buffPop(j).NumTardObj domTard = buffPop(i).TotalTardiness buffPop(j).TotalTardiness paretoIndex = ' tim strenght chua cac ca the For i = To buffSize - For j = i + 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 If (domSet < 0) And (domNum < 0) And (domTard < 0) Then buffPop(i).s = buffPop(i).s + End If ' neu j troi hon i, tang s cua j len If (domSet > 0) And (domNum > 0) And (domTard > 0) Then buffPop(j).s = buffPop(j).s + End If Next 'j Next ' i ' ket thuc xac dinh strenght ' 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 streng cua j If domSet > And domNum > And domTard > 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 < And domNum < And domTard < Then buffPop(j).r = buffPop(j).r + buffPop(i).s End If Next 'j Next ' i ' ket thuc tinh r '' phan tu nao co r = 0, thi phan tu la phan tu thuoc pareto ' sap xep cac phan tu buffPop theo thu tu giam dan cua r For i = To buffSize - For j = i + To buffSize Trang 29 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 cua ca the den cac ca the khac ' tinh khoang cach tu ca the toi cac ca the khac, tinh fitness Dim distanceList() As Double ReDim distanceList(buffSize) Dim temp As Double Dim x, y, Kth As Integer Kth = CInt(Sqr(buffSize)) For i = To buffSize ' tinh khoang cach tu ca the i toi cac ca the khac buffpop ' neu i=j thi set la -1 For j = To buffSize If i = j Then distanceList(i) = -1 Else distanceList(j) = Sqr((buffPop(i).SetupCost buffPop(j).SetupCost) ^ + (buffPop(i).TotalTardiness buffPop(j).TotalTardiness) ^ + (buffPop(i).NumTardObj buffPop(j).NumTardObj) ^ 2) End If Next 'sap sep the thu tu giam dan For x = To buffSize - For y = x + 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(Kth + 1) Next ' i ' tinh xong khoang cach tu ca the den cac ca the khac '********* ' tinh fitness cho ca the, gan buffpop lai cho pop For i = To buffSize buffPop(i).f = buffPop(i).r + / (buffPop(i).d + 2) pop(i) = buffPop(i) ' BasicPop(i) = pop(i) Next ' ket thuc ham initParetoPop se co duoc ParetoPop voi ParetoPopsize ca the khong bi troi End Sub Function TournamentSelection() As POPULATION ' chon ca the tot nhat pop va ParetoPop cho lai tao ' chon tu popnew va ParetoPop tournamentsize ca the, tu chon phan tu tot nhat Dim i, j As Integer Dim tour, minIndex As Integer Dim tourPop() As POPULATION Dim tempPop As POPULATION ReDim tempPop.chrom(chromLength) ReDim tempPop.joblate(chromLength) Dim minF As Double 'Dim tourArray() As Double ReDim tourArray(TournamentSize) ReDim tourPop(TournamentSize) Trang 30 For i = To TournamentSize ReDim tourPop(i).chrom(chromLength) ReDim tourPop(i).joblate(chromLength) Next ' neu day la the he dau tien thi chi chon popnew ' neu day la the he thu 2, thi chon ParetoPop If firstGen = True Then For i = To TournamentSize tour = Int(Rnd * PopSize + 1) tourPop(i) = pop(tour) Next Else For i = To TournamentSize tour = Int((ParetoPopSize) * Rnd + Dim strQry, stdQry As String Dim DList() As Double ReDim DList(2, ParetoPopSize) Dim recPareto As ADODB.Recordset Set recPareto = New ADODB.Recordset stdQry = "Select * from ParetoTable where generation =" ' mo table pareottable de luu lai recPareto.Open "Select * from ParetoTable", CurrentProject.Connection, adOpenKeyset, adLockOptimistic If recPareto.EOF = False Then recPareto.MoveLast End If 1) tourPop(i) = ParetoPop(tour) Next End If ' tim phan tu co f nho nhat minF = tourPop(1).f minIndex = For i = To TournamentSize If tourPop(i).f < minF Then minF = tourPop(i).f minIndex = i End If For i = To MAXGEN ' doc cac gia tri paretotable For j = To strQry = stdQry + CStr(j) + ";" recPareto.Open strQry, CurrentProject.Connection, adOpenKeyset, adLockOptimistic recPareto.MoveFirst Do While recPareto.EOF = False Loop Next Next ' j Next 'i TournamentSelection = tourPop(minIndex) End Sub End Function Sub CompareGeneration() 'doc bang paretoTable ' so sanh khoang cach giua cac loi giai pareto giua cac the he Dim i, j As Integer Trang 31 ... 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 thực trạng điều độ cơng ty - Tìm... Weight) Khảo thực tế 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 toán thực... đổi sản phẩm tốn thời gian điều độ Cần thiết có nghiên cứu khoa học vấn ñề ñiều ñộ kế hoạch sản xuất với yêu cầu thực tế Trang 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

Ngày đăng: 16/02/2021, 19:32

TÀI LIỆU CÙNG NGƯỜI DÙNG

TÀI LIỆU LIÊN QUAN

w