• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Chuyển số thập phân sang la mã và ngược lại

Các mẹo vặt linh tinh không thuộc các nhóm trên

Điều hành viên: tungcan5diop, QUANITGROBEST

Hình đại diện của người dùng
vo_minhdat2007
Quản trị
Quản trị
Bài viết: 2227
Ngày tham gia: CN 17/07/2005 1:40 am
Has thanked: 13 time
Been thanked: 87 time
Liên hệ:

Chuyển số thập phân sang la mã và ngược lại

Gửi bàigửi bởi vo_minhdat2007 » T.Sáu 10/07/2009 4:00 pm

Tên chương trình: Chuyển số thập phân sang la mã và ngược lại
Ngôn ngữ lập trình: VB.NET
Tác giả: Sưu tầm
Chức năng: Cái tên nói lên tất cả :P



Mã: Chọn hết

  1. Private Function ConvertToRoman(ByVal pstrDecimalNumber As String) As String
  2.         '--------------------------------------------------------------------------------------
  3.  
  4.         Const strPOS_VAL As String = "IXCM"
  5.         Const strFIVE_VAL As String = "VLD"
  6.  
  7.         Dim strRoman As String
  8.         Dim strCurrRomanPos As String
  9.         Dim strLetter1 As String
  10.         Dim strLetter2 As String
  11.         Dim intCurrPos As Integer
  12.         Dim intDigit As Integer
  13.         Dim intDigitPos As Integer
  14.  
  15.         intCurrPos = 1
  16.         strRoman = ""
  17.  
  18.         For intDigitPos = Len(pstrDecimalNumber) To 1 Step -1
  19.             intDigit = Val(Mid$(pstrDecimalNumber, intDigitPos, 1))
  20.             strCurrRomanPos = Mid$(strPOS_VAL, intCurrPos, 1)
  21.             Select Case intDigit
  22.                 Case 9
  23.                     strLetter1 = strCurrRomanPos
  24.                     strLetter2 = Mid$(strPOS_VAL, intCurrPos + 1, 1)
  25.                 Case Is > 4
  26.                     strLetter1 = Mid$(strFIVE_VAL, intCurrPos, 1)
  27.                     strLetter2 = New String(strCurrRomanPos, intDigit - 5)
  28.                 Case 4
  29.                     strLetter1 = strCurrRomanPos
  30.                     strLetter2 = Mid$(strFIVE_VAL, intCurrPos, 1)
  31.                 Case Else
  32.                     strLetter1 = New String(strCurrRomanPos, intDigit)
  33.                     strLetter2 = ""
  34.             End Select
  35.             strRoman = strLetter1 & strLetter2 & strRoman
  36.             intCurrPos = intCurrPos + 1
  37.         Next
  38.  
  39.         ConvertToRoman = strRoman
  40.  
  41.     End Function


Mã: Chọn hết

  1. Private Function ConvertToDecimal(ByVal pstrRomanNumeral As String) As String
  2.         '--------------------------------------------------------------------------------------
  3.  
  4.         Dim aintRomanValues() As Integer
  5.         Dim intInputLen As Integer
  6.         Dim intX As Integer
  7.         Dim intSum As Integer
  8.  
  9.         intInputLen = Len(pstrRomanNumeral)
  10.  
  11.         If intInputLen = 0 Then
  12.             ConvertToDecimal = 0
  13.             Exit Function
  14.         End If
  15.  
  16.         ReDim aintRomanValues(intInputLen)
  17.  
  18.         For intX = 1 To intInputLen
  19.             Select Case Mid$(pstrRomanNumeral, intX, 1)
  20.                 Case "M" : aintRomanValues(intX) = 1000
  21.                 Case "D" : aintRomanValues(intX) = 500
  22.                 Case "C" : aintRomanValues(intX) = 100
  23.                 Case "L" : aintRomanValues(intX) = 50
  24.                 Case "X" : aintRomanValues(intX) = 10
  25.                 Case "V" : aintRomanValues(intX) = 5
  26.                 Case "I" : aintRomanValues(intX) = 1
  27.             End Select
  28.         Next
  29.  
  30.         For intX = 1 To intInputLen
  31.             If intX = intInputLen Then
  32.                 intSum = intSum + aintRomanValues(intX)
  33.             Else
  34.                 If aintRomanValues(intX) >= aintRomanValues(intX + 1) Then
  35.                     intSum = intSum + aintRomanValues(intX)
  36.                 Else
  37.                     intSum = intSum - aintRomanValues(intX)
  38.                 End If
  39.             End If
  40.         Next
  41.  
  42.         ConvertToDecimal = CStr(intSum)
  43.  
  44.     End Function



Hình đại diện của người dùng
alexanderdna
Guru
Guru
Bài viết: 214
Ngày tham gia: T.Ba 14/07/2009 11:13 am
Đến từ: Sài Gòn
Has thanked: 3 time
Been thanked: 15 time

Re: Chuyển số thập phân sang la mã và ngược lại

Gửi bàigửi bởi alexanderdna » CN 20/12/2009 1:01 pm

Tên chương trình: Chuyển đổi từ chữ số La Mã về chữ số Ả Rập
Ngôn ngữ lập trình: VB.NET
Tác giả: Đặng Nhật Anh
Chức năng: Như tên gọi, ngoài ra còn để trình bày thuật toán


Lâu lâu đi lạc vào đây, thấy chủ đề cũng khá thú vị, bèn suy nghĩ viết ra một hàm chuyển đổi.

Hàm chuyển đổi này kiểm tra tính chính xác của dãy số La Mã một cách khắc khe.
Trước hết, xin trình bày quy luật kiểm tra.
- Đánh chỉ số từ 0 tới 6 cho các ký tự trong dãy I, V, X, L, C, D, M.
- Gọi Cur là ký tự đang xét, Prev là ký tự vừa xét, PPrev là ký tự đứng trước Prev.
- Đặt H (hiệu số) = chỉ số của Cur - chỉ số của Prev.
Luật kiểm tra:
1. H không được lớn hơn 2.
2. Nếu H < 0 thì Cur phải khác PPrev HOẶC cả Cur, Prev và PPrev đều giống nhau.
3. Nếu H = 0 thì chỉ số của PPrev phải lớn hơn hoặc bằng chỉ số của Prev.
4. Nếu H = 1 thì chỉ số của Cur phải là số lẻ.
5. Nếu H = 2 thì chỉ số của Cur phải là số chẵn.


  1. ' Trả về -1 nếu gặp lỗi
  2. Public Function Roman2Arabic(ByVal Roman As String) As Integer
  3.     Roman = Roman.Trim.ToUpper
  4.     If Roman.Length = 0 Then Return 0
  5.    
  6.     ' Không có ký tự nào lặp lại liên tục hơn 3 lần
  7.     ' (do vậy không thể dùng kiểu cổ: IIII)
  8.     If Roman.Length > 3 Then
  9.         Dim m As Char = ""
  10.         Dim k As Integer = 1
  11.         For Each n As Char In Roman.ToCharArray
  12.             If m = n Then k += 1 Else k = 1
  13.             If k > 3 Then Return -1 ' Báo lỗi
  14.             m = n
  15.         Next n
  16.     End If
  17.  
  18.     Dim R As String = "IVXLCDM"
  19.     Dim V() As Integer = {1, 5, 10, 50, 100, 500, 1000}
  20.  
  21.     Dim Prev As Char = "", PPrev As Char = ""
  22.     Dim i As Integer = 0 ' Giá trị nguyên sẽ trả về
  23.  
  24.     For Each c As Char In Roman.ToCharArray
  25.         Select Case c ' c là Cur
  26.             Case "I"c, "V"c, "X"c, "L"c, "C"c, "D"c, "M"c ' Chỉ xét các ký tự này
  27.                 ' Chỉ số của Cur
  28.                 Dim IndexOfC As Integer = R.IndexOf(c)
  29.                 ' Chỉ số của Prev (nếu Prev chưa có thì xem như bằng IndexOfC)
  30.                 Dim IndexOfPrev As Integer = IIf(Prev = Nothing, IndexOfC, R.IndexOf(Prev))
  31.                 Select Case IndexOfC - IndexOfPrev
  32.                     Case Is < 0 ' Luật #2
  33.                         If (c <> PPrev) Or (c = Prev And c = PPrev) Then
  34.                             i += V(IndexOfC)
  35.                         Else
  36.                             Return -1 ' Báo lỗi
  37.                         End If
  38.                     Case 0 ' Luật #3
  39.                         ' Nếu PPrev chưa có thì xem như chỉ số của PPrev bằng chỉ số của Cur
  40.                         If IIf(PPrev = Nothing, IndexOfC, R.IndexOf(PPrev)) >= IndexOfC Then
  41.                             i += V(IndexOfC)
  42.                         Else
  43.                             Return -1 ' Báo lỗi
  44.                         End If
  45.                     Case 1 ' Luật #4
  46.                         If IndexOfC Mod 2 <> 0 Then ' Số lẻ
  47.                             i = i + V(IndexOfC) - 2 * V(IndexOfPrev)
  48.                         Else
  49.                             Return -1 ' Báo lỗi
  50.                         End If
  51.                     Case 2 ' Luật #5
  52.                         If IndexOfC Mod 2 = 0 Then ' Số chẵn
  53.                             i = i + V(IndexOfC) - 2 * V(IndexOfPrev)
  54.                         Else
  55.                             Return -1 ' Báo lỗi
  56.                         End If
  57.                     Case Else ' Luật #1
  58.                         Return -1 ' Báo lỗi
  59.                 End Select
  60.             Case Else
  61.                 ' Ký tự không đúng
  62.                 Return -1 ' Báo lỗi
  63.         End Select
  64.         PPrev = Prev
  65.         Prev = c
  66.     Next c
  67.  
  68.     Return i
  69. End Function


Dù có kiểm lỗi nhiều cách mấy cũng không tránh khỏi sơ xuất. Do đó rất mong mọi người giúp một tay.
Sửa lần cuối bởi alexanderdna vào ngày T.Hai 21/12/2009 8:26 am với 1 lần sửa.

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Chuyển đổi từ La Mã về Ả Rập

Gửi bàigửi bởi truongphu » CN 20/12/2009 7:57 pm

1- alexanderdna đã có ý đúng khi đặt tên chương trình là "Chuyển đổi từ La Mã về Ả Rập"; lẽ ra thêm từ "chữ số" thì chính xác hơn.
Khái niệm "thập phân" liên quan hệ đếm, và đương nhiên viết số theo chữ số la mã nhưng hệ đếm La mã vẫn là hệ thập phân
2- Thuật toán Chuyển đổi từ La Mã về Ả Rập của alexanderdna trông có vẻ "rườm rà" quá!
Thuật toán của lập trình cũng y chang cách đọc bình thường, có khác bình thường ở chổ:
* bình thường: Đọc trái sang phải, theo phép cọng. Đang từ số nhỏ chuyển qua số lớn thì ưu tiên làm phép trừ nhóm chuyển trước
vd1: XI = 10 + 1
vd2: XIX = 10 + (10 - 1)
* lập trình: (truongphu) đọc từ Phải sang Trái theo phép cọng
nếu số đọc nhỏ hơn số đã đọc liền trước (phải) thì mang dấu -
vd1: XI = 1 + 10
vd2: XIX = 10 + (-1) + 10

[Ta cũng có thể lập trình theo hướng trái sang phải theo phép cọng, nếu số đọc nhỏ hơn số kề sau thì mang dấu -]

alexanderdna nghĩ sao? Tôi đã viết code vb6 rất gọn
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
xuanquy_th
Guru
Guru
Bài viết: 792
Ngày tham gia: T.Ba 05/08/2008 9:15 pm
Đến từ: Thanh Hoá
Has thanked: 1 time
Been thanked: 10 time
Liên hệ:

Re: Chuyển số thập phân sang la mã và ngược lại

Gửi bàigửi bởi xuanquy_th » CN 20/12/2009 8:31 pm

  1. Public Function NumeralsRoman(s As String) As Integer
  2.     Dim arabic() As String, roman() As String, i1 As Integer
  3.     arabic = Split("900,400,90,40,9,4,1000,500,100,50,10,5,1", ",")
  4.     roman = Split("CM,CD,XC,XL,IX,IV,M,D,C,L,X,V,I", ",")
  5.     For i1 = 0 To UBound(roman)
  6.         s = Replace(UCase(s), roman(i1), arabic(i1) & "|")
  7.     Next i1
  8.     roman = Split(s, "|")
  9.     For i1 = 0 To UBound(roman)
  10.         NumeralsRoman = NumeralsRoman + Val(roman(i1))
  11.     Next i1
  12. End Function
Khi Chúa Trời đóng cánh cửa này lại, Ngài sẽ mở một cánh cửa khác cho ta.
Nhưng ta thường nhìn quá lâu vào cánh cửa đã đóng nên không thấy được có một cánh cửa khác đang mở ra cho ta!!!

Hình đại diện của người dùng
alexanderdna
Guru
Guru
Bài viết: 214
Ngày tham gia: T.Ba 14/07/2009 11:13 am
Đến từ: Sài Gòn
Has thanked: 3 time
Been thanked: 15 time

Re: Chuyển số thập phân sang la mã và ngược lại

Gửi bàigửi bởi alexanderdna » T.Hai 21/12/2009 8:24 am

Cảm ơn bác truongphu và anh xuanquy_th. Code của cả hai rất gọn và hữu dụng.

Gởi bác truongphu:
1. Dạ, đúng là con sơ xuất, phải ghi thêm "chữ số" mới phải đạo.
2. Lúc ban đầu con cũng có ý đọc từ phải sang trái như bác nói. Nhưng không hiểu sao rốt cuộc lại hướng thuật toán về chiều ngược lại.
- Lẽ cố nhiên, nếu muốn chuyển đổi số từ dạng La Mã về dạng Ả Rập, không nhứt thiết phải rườm rà như vậy.
- Song, ở đây con muốn trình bày song hành hai phương pháp chuyển đổi và kiểm tra. Trong đó, phần kiểm tra rất khắc khe, cố ý không bỏ sót một lỗi nào ở định dạng chuỗi số (theo 5 quy luật ghi ở trên).
- Lại nói, chuỗi số cần chuyển đổi, trong đại đa số trường hợp, là đúng định dạng (vì không phải do "tay mơ' viết ra). Do đó việc kiểm tra dường như hơi thừa thải.
-> Suy ra, đoạn mã bên trên không có tánh cách thực dụng, chỉ nhằm mục tiêu trình bày và cũng vì... ham vui.


Quay về “[.NET] Mẹo vặt khác”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách