Nghiên cứu các vấn đề trong sản xuất và phương pháp giải quyết; điều độ quá trình sản xuất của công ty TNHH thép BMB

84 41 0
Nghiên cứu các vấn đề trong sản xuất và phương pháp giải quyết; điều độ quá trình sản xuất của công ty TNHH thép BMB

Đ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

i Đại Học Quốc Gia Tp Hồ Chí Minh TRƯỜNG ĐẠI HỌC BÁCH KHOA ĐINH TẤN HUY NGHIÊN CỨU CÁC VẤN ĐỀ TRONG SẢN XUẤT VÀ PHƯƠNG PHÁP GIẢI QUYẾT; ĐIỀU ĐỘ Q TRÌNH SẢN XUẤT CỦA CƠNG TY TNHH THÉP BMB 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 06 năm 2009 ii 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 hướng dẫn khoa học : PGS.TS HỒ THANH PHONG Cán chấm nhận xét : Cán chấm nhận xét : Luận văn thạc sĩ 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 25 tháng năm 2009 iii TRƯỜNG ĐẠI HỌC BÁCH KHOA KHOA CƠ KHÍ CỘNG HÒA XÃ HỘI CHỦ NGHĨA VIỆT NAM ĐỘC LẬP – TỰ DO – HẠNH PHÚC -TP HCM, ngày tháng năm NHIỆM VỤ LUẬN VĂN THẠC SĨ Họ tên học viên: ĐINH TẤN HUY Ngày, tháng, năm sinh : Phái: Nam 05-03-1982 Nơi sinh : TP.HCM Chuyên ngành : Kỹ thuật Hệ thống Công nghiệp MSHV: 02707241 I- TÊN ĐỀ TÀI: NGHIÊN CỨU CÁC VẤN ĐỀ TRONG SẢN XUẤT VÀ PHƯƠNG PHÁP GIẢI QUYẾT; ĐIỀU ĐỘ QUÁ TRÌNH SẢN XUẤT CỦA CÔNG TY TNHH THÉP BMB II- NHIỆM VỤ VÀ NỘI DUNG: + Tìm hiểu họat động sản xuất kinh doanh Công ty TNHH Thép BMB + Xác đinh vấn đề tồn đọng tìm nguyên nhân + Xây dựng đưa giải pháp khắc phục + Thu thập số liệu, thơng tin liên quan đề tài + Lập trình phần mềm ứng dụng + Phân tích kết quả, kết luận & kiến nghị + Hoàn thành nội dung thực luận văn cao học III- NGÀY GIAO NHIỆM VỤ : 30-08-2008 IV- NGÀY HOÀN THÀNH NHIỆM VỤ : 30-04-2009 V- CÁN BỘ HƯỚNG DẪN: PGS.TS HỒ THANH PHONG CÁN BỘ HƯỚNG DẪN PGS.TS Hồ Thanh Phong CN BỘ MÔN QL CHUYÊN NGÀNH iv LỜI CẢM ƠN Trước tiên, em xin bày tỏ lòng biết ơn thầy PGS.TS Hồ Thanh Phong tận tình bảo, hướng dẫn kiến thức chuyên môn kinh nghiệm thực nghiên cứu khoa hoc em hoàn thành đề tài luận văn cao học Em xin bày tỏ lịng biết ơn tồn thể q thầy khoa trường Đại học Bách khoa đặc biệt quý thầy cô Bộ môn Kỹ thuật Hệ thống Công nghiệp, dạy bảo truyền đạt kiến thức làm tảng quan trọng cho em suốt thời gian học tập trường Đề tài luận văn cao học thực với giúp đỡ hỗ trợ Thầy Nguyễn Văn Hợp Công ty PEBs Tôi cám ơn Giám Đốc Công ty, phận CSD hết lịng ủng hộ tơi thực đề tài Sau cùng, xin gởi lời cảm ơn sâu sắc đến gia đình bạn bè giúp đỡ thời gian qua TP.HCM, ngày 30 tháng 04 năm 2009 Đinh Tấn Huy v TÓM TẮT LUẬN VĂN Đề tài luận văn cao học thực nhằm xem xét lại vấn đề tồn đọng công ty từ lúc thành lập đến Đồng thời đưa phương án giải phù hợp nhằm nâng cao lực cạnh tranh công ty Thép BMB so với thị tr ường Trước hết, tìm hiểu vấn đề tồn đọng cơng ty thực nhằm xác định nguyên nhân Việc xác lập tổng kết nguyên nhân hệ thống hóa tác động nguyên nhân máy công ty làm sở để đưa phương án giải Việc nghiên cứu mơ hình Flowshop linh hoạt cơng ty đồng thời đưa việc điều độ dùng giải thuật tìm kiếm tối ưu TaBu SA phù hợp giải phần tồn đọng công ty Tuy nhiên để giải triệt để Chủ Doanh Nghiệp phải có đầu tư thích đáng thời gian nguồn lực cho nghiên cứu Cuối cùng, phần mềm máy tính viết nhằm hỗ trợ cho công tác điều độ đơn hàng công ty vi MỤC LỤC LỜI CẢM ƠN .iv TÓM TẮT LUẬN VĂN .v MỤC LỤC .vi DANH SÁCH HÌNH VẼ ix DANH SÁCH BẢNG BIỂU ix CHƯƠNG GIỚI THIỆU ĐỀ TÀI .1 1.1 Đặt vấn đề .1 1.2 Mục tiêu đề tài 1.3 Nội dung thực 1.4 Phạm vi giới hạn & đối tượng áp dụng .2 1.5 Khung công việc CHƯƠNG CƠ SỞ LÝ THUYẾT & NGHIÊN CỨU LIÊN QUAN 2.1 Hoạch định điều độ sản xuất 2.1.1 Kế họach sản xuất .3 2.1.2 Điều độ sản xuất 2.2 Flow Shop đa quy trình 12 2.3 Các nghiên cứu liên quan 13 CHƯƠNG PHƯƠNG PHÁP LUẬN .16 3.1 Giải thuật tìm kiếm vùng cấm .16 3.2 Giải thuật SA có lời giải ban đầu (giải thuật xây dựng) NEH 16 3.2.1 Giới thiệu 16 3.2.1 NEH Heuristic- Giải thuật kinh nghiệm NEH 16 3.2.3 Giải thuật SA .17 CHƯƠNG GIỚI THIỆU HỆ THỐNG SẢN XUẤT HIỆN TẠI 19 4.1 Giới thiệu Công ty 19 4.2 Quá trình thực (sản xuất) 23 4.2.1 Quy trình xử lý công việc giai đoạn TK 23 4.2.2 Quy trình lý cơng việc giai đoạn GC 24 vii 4.2.3 Quy trình lý cơng việc giai đoạn TC 26 4.3 Phân tích trạng 27 4.3.1 Các hệ tồn đọng lại sau năm hoạt động 27 4.3.2 Các nguyên nhân (lí do) gây hệ tồn đọng 27 4.3.3 Tổng hợp lý (nguyên nhân) “Chủ Quan” gây hệ tồn đọng phương án khắc phục 29 CHƯƠNG GIẢI QUYẾT CHI TIẾT CÁC VẤN ĐỀ TỒN ĐỌNG 32 5.1 Tính chất đơn hàng (hợp đồng) 32 5.2 Vấn đề Hoạch Định Tổng Hợp Công Ty 33 5.2.1 Các mục tiêu Công ty HĐTH 33 5.2.2 Hoạch Định Tổng Hợp cho phận Thu Mua 33 5.2.3 Hoạch Định Tổng Hợp cho phận TK, GC, TC 34 5.3 Vấn đề Điều Độ đơn hàng cho Công Ty 37 5.3.1 Tại cần Điều Độ đơn hàng 37 5.3.2 Mơ hình ĐĐ công ty BMB 39 5.3.3 Thiết kế thực nghiêm ĐĐ đơn hàng công ty BMB 42 CHƯƠNG KẾT LUẬN VÀ KIẾN NGHỊ 49 6.1 Kết luận 49 6.2 Kiến nghị 49 6.2.1 Những hạn chế 49 6.2.2 Hướng phát triển 49 TÀI LIỆU THAM KHẢO A PHỤ LỤC B Bài tốn ví dụ giải thuật NEH B Bài tốn ví dụ giải thuật SA B Mã nguồn chương trình B viii DANH SÁCH HÌNH VẼ Hình 2.1: Tương quan kế hoạch tổng hợp kế hoạch khác Hình 2.2: Quá trình hoạch định kế hoạch tổng hợp Hình 2.3: Biểu đồ dịng thơng tin hệ thống sản xuất Hình 2.4: Các loại hình sản xuất Hình 2.5: Mơ hình máy Hình 2.6: Mơ hình máy song song Hình 2.7: Mơ hình tốn Flowshop 10 Hình 2.8: Mơ hình tốn Jobshop 10 Hình 2.9: Giản đồ FSMP 12 Hình 4.1: Sơ đồ tổ chức Công Ty 20 Hình 4.2: Doanh thu cơng ty qua năm 21 Hình 4.3: Giản đồ dịng cơng việc qua phận công ty 23 Hình 4.4: Dịng cơng việc qua phận TK cơng ty 24 Hình 4.5: Thời gian xử lý công việc giai đoạn TK 24 Hình 4.6: Dịng cơng việc qua phận GC cơng ty 25 Hình 4.7: Thời gian xử lý công việc giai đoạn GC 25 Hình 4.8: Thời gian xử lý công việc (đơn hàng) giai đoạn GC 25 Hình 4.9: Dịng cơng việc qua phận TC công ty 26 Hình 4.10: Thời gian xử lý cơng việc giai đoạn TC 26 Hình 4.11: Tổng hợp nguyên nhân gây hậu Cơng ty BMB 30 Hình 5.1: Các giai đoạn đơn hàng (dự án) theo thời gian 37 Hình 5.2: Tương quan thu chi đơn hàng (dự án) theo giai đoạn 37 Hình 5.3: Mơ hình hoạt đơng (sản xuất) đơn hàng Công Ty 38 Hình 5.4: Màn hình chương trình 44 Hình 5.5: Màn hình nhập liệu 45 Hình 5.6: Màn hình sau nhập liệu 45 Hình 5.7: Màn hình kết quả, biểu đồ Grant cho phương án “Sắp xếp tay” 46 Hình 5.8: Màn hình kết quả, biểu đồ Grant cho phương án “Sắp xếp theo giải thuật Tabu” 47 Hình 5.9: Màn hình kết quả, biểu đồ Grant cho phương án “Sắp xếp theo giải thuật SA” 48 ix DANH SÁCH BẢNG BIỂU Bảng 2.1 Mục tiêu hoạch định tổng hợp Bảng 5.1 Hoạch Định Tổng Hợp phận Thu Mua 33 Bảng 5.2 Hoạch Định Tổng Hợp phận Thiết kế 34 Bảng 5.3 Hoạch Định Tổng Hợp phận Gia Công (Nhà Máy) 35 Bảng 5.4 Hoạch Định Tổng Hợp phận Thi Công 36 Bảng 5.5 Kết Điều Độ theo Phương án 48 DANH SÁCH CÁC TỪ VIẾT TẮT Từ viết tắt Giải thích ĐĐ SB HĐTH TK GC TC FSMP SA Điều độ Shifting Bottleneck Hoạch Đinh Tổng Hợp Thiết Kế Gia Công Thi Công Flow Shop with Multiple Processors Simulated Annealing CHƯƠNG GIỚI THIỆU ĐỀ TÀI 1.1 Đặt vấn đề Công ty TNHH Thép BMB Công ty thành lập vào tháng Năm năm 2004 Trải qua 05 hoạt động, với phát triển vượt bậc khối lượng quy mô dự án mà công ty tham gia xây dựng, Công ty đối mặt với nhiều khó khăn khách hàng khơng trả tiền trễ tiến độ, khách hàng khơng quay lại q trình thực dự án gây tổn thất cho khách hàng, q trình thi cơng cho khách hàng bị trục trặc: khơng có vật tư thi cơng, vật tư thi cơng bị lỗi khơng thể thi cơng Các khó khăn vấn đề nảy sinh trình hoạt động Cơng Ty có tác động đến Bộ phận Dự Án, thành phần tiên phong Công ty Bộ phận Dự Án phận gặp gỡ khách hàng để tìm dự án, theo dõi dự ánkhách hàng ký hợp đồng đem tiền công ty Sau ký kết, kỹ sư (nhân viên) dự án cịn truyền đạt thơng tin phản hồi trao đổi với khách hàng suốt q trình sản xuất thi cơng Các khó khăn tác động trực tiếp lên nguồn thu công ty nói chung nhân viên dự án nói riêng Tuy nhiên chưa chưa có báo cáo, nghiên cứu xác định vấn đề đưa giải cho Bộ Phận Dự Án phận khác Cơng Ty có liên quan Tơi với vai trò thành viên Bộ phận Dự Án, có vấn đề khó khăn nhu cầu cần giải vấn đề nên đề tài “Nghiên cứu vấn đề sản xuất phương pháp giải quyết; Điều độ trình sản xuất cơng ty TNHH Thép BMB” hình thành 1.2 Mục tiêu đề tài • Xác đinh vấn đề xảy Công ty cho Bộ phận Dự Án phận khác có liên quan nhằm có nhìn tổng quan nguyên nhân đưa cách giải • Xây dựng chương trình máy tính hỗ trợ việc điều độ Bộ phận Dự Án công ty; làm Ban lãnh đạo Công ty có tầm nhìn khái qt cơng việc Bộ phận Dự Án, tăng hiệu việc tương tác chuẩn bị cho tất phận khác có liên quan B11 Public Property rDelay() As Integer Get Return _rDelay End Get Set(ByVal value As Integer) _rDelay = value End Set End Property Public ReadOnly Property Delay() As Integer Get Return _rDelay ­ _D End Get End Property ' Tinh thoi gian van hanh Public ReadOnly Property TotalP() As Integer Get Dim max As Integer = Integer.MinValue For Each item As Integer In _PTC If max = Integer.MinValue Or max < item Then max = item End If Next item Return Me.PTK + Me.PGC + max End Get End Property End Class B12 Public Class JobCollection Inherits List(Of Job) Sub New() MyBase.New() End Sub Sub New(ByVal list As List(Of Job)) MyBase.New(list) End Sub Public Sub Swap(ByVal i As Integer, ByVal j As Integer) Dim jbx As Job = Me.Item(i) Me.Item(i) = Me.Item(j) Me.Item(j) = jbx End Sub Public Function getMaxDelay() As Integer Dim maxDelay As Integer = Integer.MinValue For Each jb As Job In Me If jb.Delay > maxDelay Then maxDelay = jb.Delay End If Next jb Return maxDelay End Function 'Public Sub Run(ByVal jobs As List(Of Job)) Public Function Run() As Integer ' Tham so Thiet ke Dim Ctk As Integer = ' Tham so Gia cong Dim Cgc As Integer = ' Tham so Thi cong Dim Ctc(3) As Integer ' Tham so temp Dim tmp(3) As Integer ' lay max delay Dim maxDelay As Integer = Integer.MinValue ' Duyet tung cong viec For Each jb As Job In Me 'jobs ' Khoi tao jb.rDelay = Integer.MaxValue ' Thiet If jb.R Ctk Else Ctk End If ke > Ctk Then = jb.R + jb.PTK = Ctk + jb.PTK ' Gia cong If Cgc > Ctk Then B13 Cgc = Cgc + jb.PGC Else Cgc = Ctk + jb.PGC End If ' Thi cong tmp(1) = Cgc ­ Ctc(1) tmp(2) = Cgc ­ Ctc(2) tmp(3) = Cgc ­ Ctc(3) If tmp(1) < And tmp(2) < And tmp(3) < Then Dim maxIdx = For i As Integer = To If tmp(i) > tmp(maxIdx) Then maxIdx = i End If Next i Ctc(maxIdx) = Ctc(maxIdx) + jb.getPTCIdx(maxIdx) jb.PathProcess = "TK => GC => TC" & maxIdx.ToString() jb.rDelay = Ctc(maxIdx) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) < Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) >= And tmp(2) < And tmp(3) >= Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) >= Then Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) >= And tmp(2) < And tmp(3) < Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) < Then Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) < And tmp(2) < And tmp(3) >= Then Ctc(3) = Cgc + jb.getPTCIdx(3) jb.PathProcess = "TK => GC => TC3" jb.rDelay = Ctc(3) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) >= Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) B14 End If If jb.Delay > maxDelay Then maxDelay = jb.Delay Next jb Return maxDelay End Function Protected Function getJobCollectionDelay() As Integer 'For Each jb As Job In Me ' jb.rDelay = Integer.MaxValue 'Next jb Me.Run() Return Me.getMaxDelay() End Function Public Function TabuSearch(byval N as Integer, byval nListTabu as Integer) As JobCollection ' Thuat toan Tabu Search ' Cac bien can dung 'Dim N As Integer = 'Dim nListTabu As Integer = ' Cac bien luu gia tri Dim minJobCol As New JobCollection(Me) Dim minDelay As Integer = minJobCol.Run() 'Dim minTabu As TabuStruct ' Cac bien luu gia tri dang thuc hien Dim curJobCol As New JobCollection(Me) Dim curDelay As Integer = curJobCol.Run() 'Dim curTabu As TabuStruct ' Cac bien luu gia tri cua vong lap Dim minLocJobCol As JobCollection Dim minLocDelay As Integer Dim minLocTabu As TabuStruct ' Cac bien luu gia tri vong lap Dim tmpJobCol As JobCollection Dim tmpDelay As Integer Dim tmpTabu As TabuStruct ' luu danh sach tabu cam Dim listTabu As New List(Of TabuStruct) ' for k = to N For k As Integer = To N ' Gan gia tri ban dau cho gia tri vong lap minLocJobCol = Nothing minLocDelay = Integer.MaxValue minLocTabu = Nothing ' for i = to curJobCol.Count ­ For i As Integer = To curJobCol.Count ­ ' Lay gia tri tung day hoan vi tmpJobCol = New JobCollection(curJobCol) tmpTabu = New TabuStruct(tmpJobCol(i), tmpJobCol(i + 1)) tmpTabu.Swap() ' hoan vi de kiem tra B15 If tmpTabu.CheckInList(listTabu) = True Then Continue For tmpJobCol.Swap(i, i + 1) tmpDelay = tmpJobCol.Run() ' Kiem tra tmp co phai la gia tri hay ko If minLocJobCol Is Nothing Or minLocDelay > tmpDelay Then ' gan lai gia tri minLoc minLocJobCol = tmpJobCol minLocDelay = tmpDelay minLocTabu = tmpTabu End If ' If minLocJobCol Is Nothing Or minLocDelay > tmpDelay Then Next i If minLocJobCol Is Nothing Then Exit For ' Kiem tra minLoc la gia tri toi uu hay ko If minLocJobCol IsNot Nothing And minLocDelay < minDelay Then ' ga lai gia tri toan cuc minJobCol = minLocJobCol minDelay = minLocDelay 'minTabu = minLocTabu End If ' If minLocJobCol IsNot Nothing And minLocDelay < minDelay Then ' Khoi tao lai gia tri cur curJobCol = New JobCollection(minLocJobCol) curDelay = curJobCol.Run() ' Dua tabu cam vao danh sach If minLocJobCol IsNot Nothing Then If listTabu.Count >= nListTabu Then listTabu.RemoveAt(0) minLocTabu.Swap() listTabu.Add(minLocTabu) End If Next k Return minJobCol End Function Public Function getChartImage() As Bitmap Dim font As New Font(FontFamily.GenericSansSerif, 8, FontStyle.Regular) Dim XStart As Integer = 220 Dim XLabel As Integer = 150 Dim WDay As Integer = 20 Dim HDay As Integer = 20 Dim YTK As Integer = 40 Dim YGC As Integer = 80 Dim YTC As Integer = 100 ' Khoi tao Bitmap B16 Me.Run() Dim maxEndTime As Integer = Integer.MinValue Dim Width As Integer = Integer.MinValue Dim Height As Integer = Me.Count * (HDay + 10) + 50 ' 25 + (i * (HDay + 10)) If Height < 200 Then Height = 200 For Each jb As Job In Me If maxEndTime < jb.rDelay Then maxEndTime = jb.rDelay End If Next jb If maxEndTime = Integer.MinValue Then maxEndTime = End If Dim s As Integer = If Me.Count Then s = Me(0).R ­ Dim bmp As New Bitmap(XStart + ((maxEndTime ­ s + 5) * WDay), Height) Dim g As Graphics = Graphics.FromImage(bmp) ' Khoi tao thuat toan ' Tham so Thiet ke Dim Ctk As Integer = ' Tham so Gia cong Dim Cgc As Integer = ' Tham so Thi cong Dim Ctc(3) As Integer ' Tham so temp Dim tmp(3) As Integer ' Ve background g.FillRectangle(Brushes.Black, 0, 0, bmp.Width, bmp.Height) g.FillRectangle(Brushes.White, 0, 0, bmp.Width, bmp.Height) ' Duyet tung cong viec For Each jb As Job In Me 'jobs ' Khoi tao jb.rDelay = Integer.MaxValue ' Thiet ke If jb.R > Ctk Then ' Ve tien trinh Thiet ke g.FillRectangle(New SolidBrush(jb.Color), XStart + (jb.R ­ s) * WDay, YTK, jb.PTK * WDay, HDay) ' Cap nhat lai Ctk = jb.R + jb.PTK Else ' Ve tien trinh Thiet ke g.FillRectangle(New SolidBrush(jb.Color), XStart + (Ctk ­ s) * WDay, YTK, jb.PTK * WDay, HDay) ' Cap nhat lai Ctk = Ctk + jb.PTK End If B17 ' Gia cong If Cgc > Ctk Then ' Ve tien trinh Gia cong g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YGC, jb.PGC * WDay, HDay) Cgc = Cgc + jb.PGC Else ' Ve tien trinh Gia cong g.FillRectangle(New SolidBrush(jb.Color), XStart + (Ctk ­ s) * WDay, YGC, jb.PGC * WDay, HDay) Cgc = Ctk + jb.PGC End If ' Thi cong tmp(1) = Cgc ­ Ctc(1) tmp(2) = Cgc ­ Ctc(2) tmp(3) = Cgc ­ Ctc(3) If tmp(1) < And tmp(2) < And tmp(3) < Then Dim maxIdx = For i As Integer = To If tmp(i) > tmp(maxIdx) Then maxIdx = i End If Next i g.FillRectangle(New SolidBrush(jb.Color), XStart + (Ctc(maxIdx) ­ s) * WDay, YTC + (maxIdx * WDay), jb.getPTCIdx(maxIdx) * WDay, HDay) Ctc(maxIdx) = Ctc(maxIdx) + jb.getPTCIdx(maxIdx) jb.PathProcess = "TK => GC => TC" & maxIdx.ToString() jb.rDelay = Ctc(maxIdx) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) < Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (1 * WDay), jb.getPTCIdx(1) * WDay, HDay) Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) >= And tmp(2) < And tmp(3) >= Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (1 * WDay), jb.getPTCIdx(1) * WDay, HDay) Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) >= Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (2 * WDay), jb.getPTCIdx(2) * WDay, HDay) Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) >= And tmp(2) < And tmp(3) < Then B18 g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (1 * WDay), jb.getPTCIdx(1) * WDay, HDay) Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) < Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (2 * WDay), jb.getPTCIdx(2) * WDay, HDay) Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) < And tmp(2) < And tmp(3) >= Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (3 * WDay), jb.getPTCIdx(3) * WDay, HDay) Ctc(3) = Cgc + jb.getPTCIdx(3) jb.PathProcess = "TK => GC => TC3" jb.rDelay = Ctc(3) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) >= Then g.FillRectangle(New SolidBrush(jb.Color), XStart + (Cgc ­ s) * WDay, YTC + (1 * WDay), jb.getPTCIdx(1) * WDay, HDay) Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) End If Next jb ' Hien thi danh sach cong viec Dim delay As Integer = getMaxDelay() Dim temp As String If delay = Integer.MinValue Then g.DrawString("Do tre lon nhat: (khong co)", font, Brushes.Red, 2, 5) Else g.DrawString("Do tre lon nhat: " & getMaxDelay(), font, Brushes.Red, 2, 5) End If For i As Integer = To Me.Count ­ g.FillRectangle(New SolidBrush(Me(i).Color), 2, 25 + (i * (HDay + 10)), WDay, HDay) If Me(i).Sign.Length > 20 Then temp = Me(i).Sign.Substring(0, 10) 'g.DrawString(Me(i).Sign.Substring(0, 15) & " ", font, Brushes.Black, + WDay + 2, 27 + (i * (HDay + 10)) + 2) Else temp = Me(i).Sign 'g.DrawString(Me(i).Sign, font, Brushes.Black, + WDay + 2, 27 + (i * (HDay + 10)) + 2) End If temp &= " (do tre: " & Me(i).Delay.ToString() & ")" g.DrawString(temp, font, Brushes.Black, + WDay + 2, 27 + (i * (HDay + 10)) + 2) Next i B19 ' Ve luoi g.DrawString("Thiet ke", font, Brushes.Black, XLabel + 5, YTK + 2) g.DrawString("Gia cong", font, Brushes.Black, XLabel + 5, YGC + 2) g.DrawString("Thi cong 1", font, Brushes.Black, XLabel + 5, YTC + HDay * + 2) g.DrawString("Thi cong 2", font, Brushes.Black, XLabel + 5, YTC + HDay * + 2) g.DrawString("Thi cong 3", font, Brushes.Black, XLabel + 5, YTC + HDay * + 2) For i As Integer = To (bmp.Width / WDay) ­ g.DrawString((i + s).ToString(), font, Brushes.Black, XStart + (i * WDay ­ 5), 5) g.DrawLine(Pens.Black, XStart + (i * WDay), WDay, XStart + (i * WDay), bmp.Height) Next i Return bmp End Function End Class Structure TabuStruct Public A As Job Public B As Job Sub New(ByVal a As Job, ByVal b As Job) Me.A = a Me.B = b End Sub Public Sub Swap() Dim tmp As Job = Me.A Me.A = Me.B Me.B = tmp End Sub Function CheckInList(ByVal list As List(Of TabuStruct)) As Boolean For Each tabu As TabuStruct In list If tabu.A.Sign = Me.A.Sign And tabu.B.Sign = Me.B.Sign Then Return True End If Next tabu Return False End Function End Structure B20 Public Class Process Public Sub Run(ByVal jobs As List(Of Job)) ' Tham so Thiet ke Dim Ctk As Integer = ' Tham so Gia cong Dim Cgc As Integer = ' Tham so Thi cong Dim Ctc(3) As Integer ' Tham so temp Dim tmp(3) As Integer ' Duyet tung cong viec For Each jb As Job In jobs ' Khoi tao jb.rDelay = Integer.MaxValue ' Thiet If jb.R Ctk Else Ctk End If ke > Ctk Then = jb.R + jb.PTK = Ctk + jb.PTK ' Gia cong If Cgc > Ctk Then Cgc = Cgc + jb.PGC Else Cgc = Ctk + jb.PGC End If ' Thi cong tmp(1) = Cgc ­ Ctc(1) tmp(2) = Cgc ­ Ctc(2) tmp(3) = Cgc ­ Ctc(3) If tmp(1) < And tmp(2) < And tmp(3) < Then Dim maxIdx = For i As Integer = To If tmp(i) > tmp(maxIdx) Then maxIdx = i End If Next i Ctc(maxIdx) = Ctc(maxIdx) + jb.getPTCIdx(maxIdx) jb.PathProcess = "TK => GC => TC" & maxIdx.ToString() jb.rDelay = Ctc(maxIdx) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) < Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) >= And tmp(2) < And tmp(3) >= Then Ctc(1) = Cgc + jb.getPTCIdx(1) B21 jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) >= Then Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) >= And tmp(2) < And tmp(3) < Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) ElseIf tmp(1) < And tmp(2) >= And tmp(3) < Then Ctc(2) = Cgc + jb.getPTCIdx(2) jb.PathProcess = "TK => GC => TC2" jb.rDelay = Ctc(2) ElseIf tmp(1) < And tmp(2) < And tmp(3) >= Then Ctc(3) = Cgc + jb.getPTCIdx(3) jb.PathProcess = "TK => GC => TC3" jb.rDelay = Ctc(3) ElseIf tmp(1) >= And tmp(2) >= And tmp(3) >= Then Ctc(1) = Cgc + jb.getPTCIdx(1) jb.PathProcess = "TK => GC => TC1" jb.rDelay = Ctc(1) End If Next jb End Sub End Class B22 Public Class SASearch Inherits JobCollection Public Sub New() MyBase.New() End Sub Sub New(ByVal list As List(Of Job)) MyBase.New(list) End Sub Private Dim Dim For Function MaxTotalP(ByVal ls As SASearch) As Job maxP As Integer = Integer.MinValue jb As Job = Nothing Each itemJob As Job In ls If maxP = Integer.MinValue Or maxP < itemJob.TotalP Then jb = itemJob maxP = itemJob.TotalP End If Next itemJob Return jb End Function Private Sub AddSASearch(ByVal saSearch As SASearch) Dim tmpList As New SASearch(saSearch) ' Dua cac job lai vao danh sach ket qua For Each itemJob As Job In tmpList Me.Add(itemJob) Next itemJob End Sub Private Function NEHAlgorithm(ByVal saSearch As SASearch) As SASearch Dim tmpRList As New SASearch(saSearch) Dim tmpLList As New SASearch() Dim jb As Job ' Lay gia tri lon nhat dau tien danh sach tmp jb = Me.MaxTotalP(tmpRList) tmpRList.Remove(jb) tmpLList.Add(jb) ' Lay gia tri lon nhat ke tiep danh sach tmp jb = Me.MaxTotalP(tmpRList) tmpRList.Remove(jb) tmpLList.Add(jb) Dim tmpList1 As New SASearch(tmpLList) tmpList1.AddSASearch(tmpRList) Dim tmpList2 As New SASearch(tmpLList) tmpList2.Swap(0, 1) tmpList2.AddSASearch(tmpRList) If tmpList1.getJobCollectionDelay() > tmpList2.getJobCollectionDelay() Then tmpLList.Swap(0, 1) End If ' Da chon duoc => tmpLList, tmpRList B23 'Dim str As String = "Left: " 'For Each jb In tmpLList ' str &= jb.Name & " " 'Next jb 'str &= "\n Right: " 'For Each jb In tmpRList ' str &= jb.Name & " " 'Next jb 'MessageBox.Show(str) ' Bat dau chen cac phan tu tu tmpRList vao tmpLList Dim str As String = "" While tmpRList.Count > Dim bestDelay As Integer = Integer.MinValue Dim bestI As Integer jb = tmpRList.Item(0) tmpRList.Remove(jb) For i As Integer = To tmpLList.Count Step +1 tmpList1 = New SASearch(tmpLList) tmpList1.Insert(i, jb) tmpList1.AddSASearch(tmpRList) If bestDelay = Integer.MinValue Or bestDelay > tmpList1.getJobCollectionDelay() Then bestI = i bestDelay = tmpList1.getMaxDelay() End If Next i If bestDelay Integer.MinValue Then tmpLList.Insert(bestI, jb) End If ' Hien thi danh sach cong viec 'tmpList2 = New SASearch(tmpLList) 'tmpList2.AddSASearch(tmpRList) 'MessageBox.Show(Me.print(tmpList2)) End While Return tmpLList End Function Private Function Perturb(ByVal s As SASearch) As SASearch Dim result As New SASearch(s) If s.Count < Then Return result Dim randObj As New Random() Dim x As Integer = ((s.Count ­ 2) * randObj.NextDouble()) result.Swap(x, x + 1) Return result End Function Public Function SaAlgorithm(ByVal T0 As Integer, ByVal limitI As Integer, ByVal limitJ As Integer, ByVal HeSoT As Double) As SASearch If Me.Count < Then Return Me End If ' Khai bao bien Dim randObj As New Random() Dim S As New SASearch(Me) Dim BestS As SASearch = Me.NEHAlgorithm(Me) B24 'Dim BestS As New SASearch(Me) Dim T As Double = T0 Dim I As Integer = Dim J As Integer = ' Khoi tao S.getJobCollectionDelay() BestS.getJobCollectionDelay() ' Buoc While I < limitI For J = To limitJ Step +1 ' Buoc Dim S1 As SASearch = Me.Perturb(S) ' Buoc If BestS.getJobCollectionDelay()

Ngày đăng: 09/03/2021, 01:14

Tài liệu cùng người dùng

Tài liệu liên quan